home *** CD-ROM | disk | FTP | other *** search
/ Delphi Magazine Collection 2001 / Delphi Magazine Collection 20001 (2001).iso / DISKS / Issue35 / pageprnt / PAGEPRNT.ZIP / PagePrnt / Beta / PagePrnt.pas < prev   
Pascal/Delphi Source File  |  1997-10-30  |  93KB  |  2,775 lines
  1. {Uncomment this $DEFINE to produce the shareware version.}
  2. {You must also uncomment the line in PgPrnAbt.}
  3. //{$DEFINE PAGEPRINT_SHAREWARE}
  4. (*******************************************************************************
  5.  
  6. TPagePrinter Version 2.0
  7. 8/8/96 - 10/30/97
  8. Copyright ⌐ 1996-1997 Bill Menees
  9. bmenees@usit.net
  10. http://www.public.usit.net/bmenees
  11.  
  12. This is a VCL component that encapsulates the Printer object and does
  13. Print Preview.  I make no claim to it's correct functioning, so use
  14. it at your own risk.
  15.  
  16. It **REQUIRES** long strings, enhanced metafiles, the Win32 common
  17. controls, and it makes use of several Win32 specific API calls.
  18. This means it can't be used with Delphi 1.0, so please don't ask, beg,
  19. threaten, etc.  It has been tested with and seems to work fine with
  20. Delphi 2.0, Delphi 3.0, and C++Builder 1.0.
  21.  
  22. Before you e-mail me with a question, MAKE SURE YOU CHECK THE SOURCE CODE FIRST!
  23. I don't mind helping people with problems if they have honestly tried to
  24. solve the problem first.  However, I won't even reply to questions whose
  25. answers are obvious when you look at the source (e.g. Can I use this with
  26. Delphi 1.0?).
  27.  
  28. Historical Note: This component has its origins in TLinePrinter.
  29. I started off calling this component TLinePrinter Version 2.0, but
  30. I decided a new class name was more appropriate for several reasons.  The
  31. main reason was that TLinePrinter is a non-visual component, and the new
  32. component is a visual component.  I didn't want the new visual component to
  33. start showing up on forms where the V.1.0 component hadn't shown!  A new
  34. class name also gave me the chance to redefine the interface entirely.
  35. I added, edited, renamed, and deleted many properties, methods, events,
  36. and units.  I think you'll agree the changes are for the better.
  37.  
  38. *******************************************************************************)
  39.  
  40. {$LONGSTRINGS ON}
  41. unit PagePrnt;
  42.  
  43. interface
  44.  
  45. uses
  46.   Windows, Messages, SysUtils, Classes, Graphics, Controls,
  47.   Forms, Dialogs, Printers, ExtCtrls,
  48. {$IFDEF PAGEPRINT_SHAREWARE}
  49.   PgPrnPrg, PgPrnAbt;
  50. {$ELSE}
  51.   PgPrnPrg;
  52. {$ENDIF}
  53.  
  54. const
  55.   {In Pixels}
  56.   DefaultBorderWidth = 2;
  57.   DefaultDPI = 300;
  58.   {In Inches}
  59.   DefaultAvailablePageHeightIn = 10.5;
  60.   DefaultAvailablePageWidthIn = 8.0;
  61.   DefaultGutterLeftIn = 0.25;
  62.   DefaultGutterTopIn = 0.25;
  63.   DefaultPhysicalPageHeightIn = 11.0;
  64.   DefaultPhysicalPageWidthIn = 8.5;
  65.   {In Millimeters}
  66.   DefaultAvailablePageHeightMm = 284.0;
  67.   DefaultAvailablePageWidthMm = 198.0;
  68.   DefaultGutterLeftMm = 6.0;
  69.   DefaultGutterTopMm = 6.0;
  70.   DefaultPhysicalPageHeightMm = 297.0;
  71.   DefaultPhysicalPageWidthMm = 210.0;
  72.   {These are expanded only in Headers, Footers, and Tables.}
  73.   DateField = '{$DATE}';
  74.   LineField = '{$LINE}';
  75.   PageField = '{$PAGE}';
  76.   TimeField = '{$TIME}';
  77.   TitleField = '{$TITLE}';
  78.   {Progress Dialog Messages}
  79.   ProgressFinishMsg = '<FINISH>';
  80.   SendingPagesMsg = 'Sending Pages To Printer';
  81.  
  82. type
  83.   EPagePrinter = class(EPrinter);
  84.   TGradientOrientation = (goHorizontal, goVertical);
  85.   TLineSpacing = (lsHalfSpace, lsSingleSpace, lsSingleAndAHalf, lsDoubleSpace);
  86.   TMeasurement = Double;
  87.   TMeasureUnit = (muInches, muMillimeters);
  88.   TPageBorder = (pbTop, pbBottom, pbLeft, pbRight);
  89.   TPageBorders = set of TPageBorder;
  90.   TPixels = Cardinal;
  91.   TPrintCanvas = TMetafileCanvas;
  92.   TPrintPage = TMetafile;
  93.   TZoomLocation = (zlTopLeft, zlTopCenter, zlCenter);
  94.  
  95.   {Types needed for OnGetCellFormat event.}
  96.   TTableLineColumnInfo = record
  97.     Text: String;
  98.     Width: TMeasurement;
  99.     Alignment: TAlignment;
  100.     DrawGrid: Boolean;
  101.   end;
  102.   TGetCellFormatEvent = procedure(Sender: TObject; const Col: Cardinal;
  103.                       var ColInfo: TTableLineColumnInfo) of object;
  104.  
  105.   TPageList = class(TList)
  106.   public
  107.         destructor Destroy; override;
  108.         function GetPage(const Index: Integer): TPrintPage;
  109.   end;
  110.  
  111.   TPagePrinter = class(TScrollBox)
  112.   private
  113.     { Private declarations }
  114.     fAbortOnCancel: Boolean;
  115.     fAlignment: TAlignment;
  116.     fAutoFooterFont: Boolean;
  117.     fAutoHeaderFont: Boolean;
  118.     fCancelPrinting: Boolean;
  119.     fCanvas: TPrintCanvas;
  120.     fCollate: Boolean;
  121.     fCopies: Cardinal;
  122.     {These X,Y are relative to the printable space.
  123.      They should normally be bounded by the Margins.
  124.      So 0,0 is the left,top corner of the printable space.
  125.      fCurrentY is negative only when printing the header.}
  126.     fCurrentX, fCurrentY: Integer;
  127.     fDefaultColWidth: TMeasurement;
  128.     fFileName: String;
  129.     fFileVar: TextFile;
  130.     fFooterFont: TFont;
  131.     fFriendlyFooter: String;
  132.     fFriendlyHeader: String;
  133.     fGradientBackground: Boolean;
  134.     fHeader, fFooter: String;
  135.     fHeaderFont: TFont;
  136.     fHeaderFormat, fFooterFormat: String;
  137.     fLineNumber: Cardinal;
  138.     fLines: TStrings;
  139.     fLineSpace: TPixels;
  140.     fLineSpacing: TLineSpacing;
  141.     fMarginBottom: TMeasurement;
  142.     fMarginLeft: TMeasurement;
  143.     fMarginRight: TMeasurement;
  144.     fMarginTop: TMeasurement;
  145.     fMeasureUnit: TMeasureUnit;
  146.     fOnNewLine: TNotifyEvent;
  147.     fOnNewPage: TNotifyEvent;
  148.     fOnGetCellFormat: TGetCellFormatEvent;
  149.     fPage: TPrintPage;
  150.     fPageBorderOffset: TMeasurement;
  151.     fPageBorders: TPageBorders;
  152.     fPageNumber: Cardinal;
  153.     fPages: TPageList;
  154.     fPaintBox: TPaintBox;
  155.     fPPPrnPrgDlg: TPPPrnPrgDlg;
  156.     fPrinter: TPrinter;
  157.     fPrintFromPage: Cardinal;
  158.     fPrinting: Boolean;
  159.     fPrintingHeaderOrFooter: Boolean;
  160.     fPrintingToFile: Boolean;
  161.     fPrintToFile: Boolean;
  162.     fPrintToPage: Cardinal;
  163.     fProgressMessage: String;
  164.     fShadowColor: TColor;
  165.     fShadowOffset: TPixels;
  166.     fShowCancel: Boolean;
  167.     fShowMargins: Boolean;
  168.     fShowProgress: Boolean;
  169.     fStillCreating: Boolean;
  170.     fTableFormat: String;
  171.     fTableGrid: Boolean;
  172.     fTabSize: Cardinal;
  173.     fTextMetrics: TTextMetric;
  174.     fTokenSeparator: Char;
  175.     fUpdateRefCount: Cardinal;
  176.     fUsingTempPage: Boolean;
  177.     fWordWrap: Boolean;
  178.     fZoomLocation: TZoomLocation;
  179.     fZoomPercent: Cardinal;
  180.  
  181.     function GetAutoFooterFont: Boolean;
  182.     function GetAutoHeaderFont: Boolean;
  183.     function GetAvailablePageHeight: TMeasurement;
  184.     function GetAvailablePageWidth: TMeasurement;
  185.     function GetCanvas: TPrintCanvas;
  186.     function GetCanvasPosition: TPoint;
  187.     function GetCollate: Boolean;
  188.     function GetCopies: Cardinal;
  189.     function GetDefaultColWidth: TMeasurement;
  190.     function GetFileName: String;
  191.     function GetFooterFont: TFont;
  192.     function GetFooterFormat: String;
  193.     function GetFriendlyFooter: String;
  194.     function GetFriendlyHeader: String;
  195.     function GetGradientBackground: Boolean;
  196.     function GetGutterBottom: TMeasurement;
  197.     function GetGutterLeft: TMeasurement;
  198.     function GetGutterRight: TMeasurement;
  199.     function GetGutterTop: TMeasurement;
  200.     function GetHeaderFont: TFont;
  201.     function GetHeaderFormat: String;
  202.     function GetLineNumber: Cardinal;
  203.     function GetLines: TStrings;
  204.     function GetLineSpacing: TLineSpacing;
  205.     function GetMarginBottom: TMeasurement;
  206.     function GetMarginLeft: TMeasurement;
  207.     function GetMarginRight: TMeasurement;
  208.     function GetMarginTop: TMeasurement;
  209.     function GetMeasureUnit: TMeasureUnit;
  210.     function GetOrientation: TPrinterOrientation;
  211.     function GetPageBorderOffset: TMeasurement;
  212.     function GetPageBorders: TPageBorders;
  213.     function GetPageCount: Cardinal;
  214.     function GetPageNumber: Cardinal;
  215.     function GetPages(Indx: Cardinal): TPrintPage;
  216.     function GetPhysicalPageHeight: TMeasurement;
  217.     function GetPhysicalPageWidth: TMeasurement;
  218.     function GetPreviewPagePixelsH: TPixels;
  219.     function GetPreviewPagePixelsV: TPixels;
  220.     function GetPrintableHeight: TMeasurement;
  221.     function GetPrintableWidth: TMeasurement;
  222.     function GetPrintFromPage: Cardinal;
  223.     function GetPrinting: Boolean;
  224.     function GetPrintToFile: Boolean;
  225.     function GetPrintToPage: Cardinal;
  226.     function GetProgressMessage: String;
  227.     function GetShadowColor: TColor;
  228.     function GetShadowOffset: TPixels;
  229.     function GetShowCancel: Boolean;
  230.     function GetShowMargins: Boolean;
  231.     function GetShowProgress: Boolean;
  232.     function GetTableFormat: String;
  233.     function GetTitle: String;
  234.     function GetZoomPercent: Cardinal;
  235.     function PixelPrintHeight: TPixels;
  236.     function PixelPrintWidth: TPixels;
  237.     function StartingBottom: TPixels;
  238.     function StartingLeft: TPixels;
  239.     function StartingRight: TPixels;
  240.     function StartingTop: TPixels;
  241.     function StoreFooterAndFormat: Boolean;
  242.     function StoreFooterFont: Boolean;
  243.     function StoreHeaderAndFormat: Boolean;
  244.     function StoreHeaderFont: Boolean;
  245.  
  246.     procedure CMFontChanged(var Msg: TMessage); message CM_FONTCHANGED;
  247.     procedure CreateTempPage;
  248.     procedure DoNewPageProcessing;
  249.     procedure FinishPrintPage;
  250.     procedure NewPrintPage;
  251.     procedure OnCancelPrinting(Sender: TObject);
  252.     procedure ResetPageList(CreateForReal: Boolean);
  253.     procedure SetAutoFooterFont(Value: Boolean);
  254.     procedure SetAutoHeaderFont(Value: Boolean);
  255.     procedure SetCollate(Value: Boolean);
  256.     procedure SetCopies(Value: Cardinal);
  257.     procedure SetDefaultColWidth(Value: TMeasurement);
  258.     procedure SetFileName(Value: String);
  259.     procedure SetFooterFont(Value: TFont);
  260.     procedure SetFooterFormat(Value: String);
  261.     procedure SetFriendlyFooter(Value: String);
  262.     procedure SetFriendlyHeader(Value: String);
  263.     procedure SetGradientBackground(Value: Boolean);
  264.     procedure SetHeaderFont(Value: TFont);
  265.     procedure SetHeaderFormat(Value: String);
  266.     procedure SetLines(Value: TStrings);
  267.     procedure SetLineSpacing(Value: TLineSpacing);
  268.     procedure SetMarginBottom(Value: TMeasurement);
  269.     procedure SetMarginLeft(Value: TMeasurement);
  270.     procedure SetMarginRight(Value: TMeasurement);
  271.     procedure SetMarginTop(Value: TMeasurement);
  272.     procedure SetMeasureUnit(Value: TMeasureUnit);
  273.     procedure SetOrientation(Value: TPrinterOrientation);
  274.     procedure SetPageBorderOffset(Value: TMeasurement);
  275.     procedure SetPageBorders(Value: TPageBorders);
  276.     procedure SetPageNumber(Value: Cardinal);
  277.     procedure SetPrintFromPage(Value: Cardinal);
  278.     procedure SetPrintToFile(Value: Boolean);
  279.     procedure SetPrintToPage(Value: Cardinal);
  280.     procedure SetProgressMessage(Value: String);
  281.     procedure SetShadowColor(Value: TColor);
  282.     procedure SetShadowOffset(Value: TPixels);
  283.     procedure SetShowCancel(Value: Boolean);
  284.     procedure SetShowMargins(Value: Boolean);
  285.     procedure SetShowProgress(Value: Boolean);
  286.     procedure SetTableFormat(Value: String);
  287.     procedure SetTitle(Value: String);
  288.     procedure SetZoomPercent(Value: Cardinal);
  289.  
  290.   protected
  291.     { Protected declarations }
  292.     function ExpandLogicalFields(S: String): String;
  293.     function GetClippedLine(const Line: String; const Width: TPixels): String;
  294.     function GetPreviewPagePixels(Horz: Boolean): TPixels;
  295.     function GetPrinterHandle: HDC;
  296.     function GetScaleFactor(Horz: Boolean): Double;
  297.     function MeasureUnitsToScreenPixels(const Value: TMeasurement; Horz: Boolean): TPixels;
  298.     function ScaleValue(Value: TMeasurement; Horz: Boolean): TPixels;
  299.     function ValidateFormatString(const Fmt: String; const ConvertUnits: Boolean): String;
  300.     procedure ExpandFriendlyFormat(const UserFmt: String; AsHeader: Boolean);
  301.     procedure Invalidate; override;
  302.     procedure Loaded; override;
  303.     procedure PaintPreview(Sender: TObject); virtual; //OnPaint handler for TPaintBox
  304.     procedure ParseFormatToken(var CurToken: String; var CurAlignment: TAlignment; var CurWidth: TMeasurement);
  305.     procedure SetPixelsPerInch;
  306.     procedure SplitLine(var CurLine: String; var Buffer: String; const ClipWidth: TPixels; const TrimLastWhiteSpace: Boolean);
  307.     procedure SplitLineAndPrint(const Line: String; UseWrite: Boolean);
  308.     procedure UpdateDesigner;
  309.     procedure UpdatePagePreviewSize;
  310.     procedure UpdateProgressDlg(const Status: String; const CurrentPage, FromPage, ToPage: Cardinal);
  311.     procedure WriteTableGrid(const CurWidth: TPixels; const TopGrid, BottomGrid: Boolean);
  312.  
  313.   public
  314.     { Public declarations }
  315.     {Largest printable space on the page.}
  316.     property AvailablePageHeight: TMeasurement read GetAvailablePageHeight;
  317.     property AvailablePageWidth: TMeasurement read GetAvailablePageWidth;
  318.     property Canvas: TPrintCanvas read GetCanvas;
  319.     property CanvasPosition: TPoint read GetCanvasPosition;
  320.     property GutterBottom: TMeasurement read GetGutterBottom;
  321.     property GutterLeft: TMeasurement read GetGutterLeft;
  322.     property GutterRight: TMeasurement read GetGutterRight;
  323.     property GutterTop: TMeasurement read GetGutterTop;
  324.     property LineNumber: Cardinal read GetLineNumber;
  325.     property PageCount: Cardinal read GetPageCount;
  326.     property PageNumber: Cardinal read GetPageNumber write SetPageNumber;
  327.     property Pages[Indx: Cardinal]: TPrintPage read GetPages;
  328.     property PhysicalPageHeight: TMeasurement read GetPhysicalPageHeight;
  329.     property PhysicalPageWidth: TMeasurement read GetPhysicalPageWidth;
  330.     {Printable space bounded by the margins.}
  331.     property PrintableHeight: TMeasurement read GetPrintableHeight;
  332.     property PrintableWidth: TMeasurement read GetPrintableWidth;
  333.     property PrintFromPage: Cardinal read GetPrintFromPage write SetPrintFromPage default 0;
  334.     property Printing: Boolean read GetPrinting;
  335.     property PrintToPage: Cardinal read GetPrintToPage write SetPrintToPage default 0;
  336.  
  337.     constructor Create(Owner: TComponent); override;
  338.     destructor Destroy; override;
  339.     function MeasureUnitsToPixelsH(const M: TMeasurement): TPixels;
  340.     function MeasureUnitsToPixelsV(const M: TMeasurement): TPixels;
  341.     function NewLine: Cardinal;
  342.     function NewPage: Cardinal;
  343.     function PixelsToMeasureUnitsH(const P: TPixels): TMeasurement;
  344.     function PixelsToMeasureUnitsV(const P: TPixels): TMeasurement;
  345.     function PrevLine: Boolean;
  346.     function Print: Boolean;
  347.     procedure BeginDoc;
  348.     procedure BeginUpdate;
  349.     procedure Clear;
  350.     procedure EndDoc;
  351.     procedure EndUpdate;
  352.     procedure RefreshProperties;
  353.     procedure Write(const Line: String);
  354.     procedure WriteLine(const Line: String);
  355.     procedure WriteLineAligned(const AAlignment: TAlignment; const Line: String);
  356.     procedure WriteLines(const LinesAsTable: Boolean);
  357.     procedure WriteTableLine(const Line: String);
  358.     procedure ZoomToFit;
  359.     procedure ZoomToHeight;
  360.     procedure ZoomToWidth;
  361.  
  362.   published
  363.     { Published declarations }
  364.     {Because everything in TPagePrinter depends on it, this property MUST be the first
  365.     TPagePrinter-specific property loaded.  If you edit the form as text and move it
  366.     around in the streaming order, things may not work correctly.  This dependency kind
  367.     of stinks, but I can't think of any way around it.  Sorry.}
  368.     property MeasureUnit: TMeasureUnit read GetMeasureUnit write SetMeasureUnit default muInches;
  369.  
  370.     property AbortOnCancel: Boolean read fAbortOnCancel write fAbortOnCancel default False;
  371.     property Align;
  372.     property Alignment: TAlignment read fAlignment write fAlignment default taLeftJustify;
  373.     property AutoFooterFont: Boolean read GetAutoFooterFont write SetAutoFooterFont default True;
  374.     property AutoHeaderFont: Boolean read GetAutoHeaderFont write SetAutoHeaderFont default True;
  375.     property Collate: Boolean read GetCollate write SetCollate default True;
  376.     property Color;
  377.     property Copies: Cardinal read GetCopies write SetCopies default 1;
  378.     property DefaultColWidth: TMeasurement read GetDefaultColWidth write SetDefaultColWidth stored True;
  379.     property DragCursor;
  380.     property DragMode;
  381.     property Enabled;
  382.     property FileName: String read GetFileName write SetFileName;
  383.     property Footer: String read fFooter write fFooter stored StoreFooterAndFormat;
  384.     property FooterFont: TFont read GetFooterFont write SetFooterFont stored StoreFooterFont;
  385.     property FooterFormat: String read GetFooterFormat write SetFooterFormat stored StoreFooterAndFormat;
  386.     property FriendlyFooter: String read GetFriendlyFooter write SetFriendlyFooter;
  387.     property FriendlyHeader: String read GetFriendlyHeader write SetFriendlyHeader;
  388.     property GradientBackground: Boolean read GetGradientBackground write SetGradientBackground default True;
  389.     property Header: String read fHeader write fHeader stored StoreHeaderAndFormat;
  390.     property HeaderFont: TFont read GetHeaderFont write SetHeaderFont stored StoreHeaderFont;
  391.     property HeaderFormat: String read GetHeaderFormat write SetHeaderFormat stored StoreHeaderAndFormat;
  392.     property Lines: TStrings read GetLines write SetLines;
  393.     property LineSpacing: TLineSpacing read GetLineSpacing write SetLineSpacing default lsSingleSpace;
  394.     property MarginBottom: TMeasurement read GetMarginBottom write SetMarginBottom;
  395.     property MarginLeft: TMeasurement read GetMarginLeft write SetMarginLeft;
  396.     property MarginRight: TMeasurement read GetMarginRight write SetMarginRight;
  397.     property MarginTop: TMeasurement read GetMarginTop write SetMarginTop;
  398.     property OnGetCellFormat: TGetCellFormatEvent read fOnGetCellFormat write fOnGetCellFormat;
  399.     property OnNewLine: TNotifyEvent read fOnNewLine write fOnNewLine;
  400.     property OnNewPage: TNotifyEvent read fOnNewPage write fOnNewPage;
  401.     property OnStartDrag;
  402.     property Orientation: TPrinterOrientation read GetOrientation write SetOrientation default poPortrait;
  403.     property PageBorderOffset: TMeasurement read GetPageBorderOffset write SetPageBorderOffset;
  404.     property PageBorders: TPageBorders read GetPageBorders write SetPageBorders default [];
  405.     property ParentColor;
  406.     property ParentFont default False;
  407.     property PrintToFile: Boolean read GetPrintToFile write SetPrintToFile default False;
  408.     property ProgressMessage: String read GetProgressMessage write SetProgressMessage;
  409.     property ShadowColor: TColor read GetShadowColor write SetShadowColor default clBtnShadow;
  410.     property ShadowOffset: TPixels read GetShadowOffset write SetShadowOffset default 5;
  411.     property ShowHint;
  412.     property ShowCancel: Boolean read GetShowCancel write SetShowCancel default True;
  413.     property ShowMargins: Boolean read GetShowMargins write SetShowMargins default True;
  414.     property ShowProgress: Boolean read GetShowProgress write SetShowProgress default True;
  415.     property TableFormat: String read GetTableFormat write SetTableFormat;
  416.     property TableGrid: Boolean read fTableGrid write fTableGrid default False;
  417.     property TabSize: Cardinal read fTabSize write fTabSize default 8;
  418.     property Title: String read GetTitle write SetTitle nodefault;
  419.     property TokenSeparator: Char read fTokenSeparator write fTokenSeparator default '|';
  420.     property Visible;
  421.     property WordWrap: Boolean read fWordWrap write fWordWrap default True;
  422.     property ZoomLocation: TZoomLocation read fZoomLocation write fZoomLocation default zlTopLeft;
  423.     property ZoomPercent: Cardinal read GetZoomPercent write SetZoomPercent default 25;
  424.   end;
  425.  
  426. function ExpandTabsAsSpaces(const S: String; const TabSize: Cardinal): String;
  427. function GenSpace(const Size: Cardinal): String;
  428. function ReplaceSubString(const OldSubStr, NewSubStr: String; S: String): String;
  429. function StripBackToWhiteSpace(const S: String): String;
  430. procedure FillGradient(Canvas: TCanvas; Rc: TRect; LeftTopColor, RightBottomColor: TColor; Orientation: TGradientOrientation);
  431. procedure TokenizeString(const S: String; TokenSeparator: Char; Tokens: TStringList);
  432.  
  433. implementation
  434.  
  435. {Typically gutters are symmetrical on printers, but GetDeviceCaps
  436. doesn't report back bottom or right gutters.  If I calculate these
  437. gutters based on other information returned by GetDeviceCaps (instead
  438. of just assuming things are symmetrical), I get a smaller and
  439. typically incorrect result.  I think symmetric gutters are what we
  440. want in most cases, but you can comment this $DEFINE out if you want
  441. the gutters to be calculated based on the exact values returned by
  442. GetDeviceCaps.}
  443. {$DEFINE USE_SYMMETRIC_GUTTERS}
  444.  
  445. {$R PagePrnt.dcr}
  446.  
  447. {=============================================================================}
  448. { Non-methods that may prove useful elsewhere.                                }
  449. {=============================================================================}
  450.  
  451. function ReplaceSubString(const OldSubStr, NewSubStr: String; S: String): String;
  452. var
  453.    P: Cardinal;
  454. begin
  455.      {Currently, this routine is terribly inefficient since Pos
  456.      always starts back at the beginning of the string.  However,
  457.      our header, footer, and table strings are usually very short,
  458.      so this doesn't matter much in practice.}
  459.      Result := '';
  460.      P := Pos(OldSubStr, S);
  461.      while (P <> 0) do
  462.      begin
  463.           Result := Result + Copy(S, 1, P-1) + NewSubStr;
  464.           Delete(S, 1, P-1+Length(OldSubStr));
  465.           P := Pos(OldSubStr, S);
  466.      end;
  467.      Result := Result+S;
  468. end;
  469.  
  470. procedure TokenizeString(const S: String; TokenSeparator: Char;
  471.           Tokens: TStringList);
  472. var
  473.    i, Len: Cardinal;
  474.    CurToken: String;
  475. begin
  476.      Tokens.Clear;
  477.      CurToken:='';
  478.      Len:=Length(S);
  479.      for i:=1 to Len do
  480.      begin
  481.           if S[i] = TokenSeparator then
  482.           begin
  483.                Tokens.Add(CurToken);
  484.                CurToken:='';
  485.           end
  486.           else
  487.               CurToken:=CurToken+S[i];
  488.      end;
  489.      Tokens.Add(CurToken);
  490. end;
  491.  
  492. function StripBackToWhiteSpace(const S: String): String;
  493. var
  494.    i, Len, Mark: Cardinal;
  495. begin
  496.      Mark:=0;
  497.      Len:=Length(S);
  498.      for i:=Len downto 1 do
  499.      begin
  500.           if S[i] in [#0..#32] then
  501.           begin
  502.                Mark:=i;
  503.                Break;
  504.           end;
  505.      end;
  506.  
  507.      if Mark > 0 then Result:=Copy(S, 1, Mark)
  508.      {If there is nowhere to break, just return the whole line.}
  509.      else Result:=S;
  510. end;
  511.  
  512. function ExpandTabsAsSpaces(const S: String; const TabSize: Cardinal): String;
  513. var
  514.    i, Len, Size: Cardinal;
  515.    Buffer: String;
  516. begin
  517.      {TabStr:='';
  518.      for i:=1 to TabSize do TabStr:=TabStr+' ';}
  519.  
  520.      Buffer:='';
  521.      Len:=Length(S);
  522.      for i:=1 to Len do
  523.      begin
  524.           if S[i]=#9 then
  525.           begin
  526.                Size:=TabSize-(Length(Buffer) mod TabSize);
  527.                Buffer:=Buffer+GenSpace(Size);
  528.           end
  529.           else Buffer:=Buffer+S[i];
  530.      end;
  531.      Result:=Buffer;
  532. end;
  533.  
  534. function GenSpace(const Size: Cardinal): String;
  535. var
  536.    Str: String;
  537. begin
  538.      Str:='';
  539.      while Length(Str) < Size do Str:=Str+' ';
  540.      GenSpace:=Str;
  541. end;
  542.  
  543. procedure FillGradient(Canvas: TCanvas; Rc: TRect;
  544.           LeftTopColor, RightBottomColor: TColor; Orientation: TGradientOrientation);
  545. var
  546.    LR, LG, LB, RR, RG, RB, MR, MG, MB: Integer; //Left, Right, and Mix RGBs
  547.    i, LeftRGB, RightRGB, LeftWeight, RightWeight, Times: Longint;
  548.    MixColor: TColor;
  549. begin
  550.      LeftRGB:=ColorToRGB(LeftTopColor);
  551.      LR:=GetRValue(LeftRGB);
  552.      LG:=GetGValue(LeftRGB);
  553.      LB:=GetBValue(LeftRGB);
  554.      RightRGB:=ColorToRGB(RightBottomColor);
  555.      RR:=GetRValue(RightRGB);
  556.      RG:=GetGValue(RightRGB);
  557.      RB:=GetBValue(RightRGB);
  558.      if Orientation = goHorizontal then
  559.         Times:=Rc.Right-Rc.Left-1
  560.      else
  561.          Times:=Rc.Bottom-Rc.Top-1;
  562.      if Times > 0 then
  563.      begin
  564.           for i:=0 to Times do
  565.           begin
  566.                LeftWeight:=Times-i;
  567.                RightWeight:=i;
  568.                MR:=(LR*LeftWeight+RR*RightWeight) div Times;
  569.                MG:=(LG*LeftWeight+RG*RightWeight) div Times;
  570.                MB:=(LB*LeftWeight+RB*RightWeight) div Times;
  571.                MixColor:=RGB(MR, MG, MB);
  572.                with Canvas do
  573.                begin
  574.                     {Pen.Color:=MixColor;}
  575.                     Brush.Color:=MixColor;
  576.                     if Orientation = goHorizontal then
  577.                        {PolyLine([ Point(Rc.Left+i,Rc.Top), Point(Rc.Left+i,Rc.Bottom) ])}
  578.                        FillRect(Rect(Rc.Left+i, Rc.Top, Rc.Left+i+1, Rc.Bottom))
  579.                     else
  580.                         {PolyLine([ Point(Rc.Left, Rc.Top+i), Point(Rc.Right, Rc.Top+i) ]);}
  581.                         FillRect(Rect(Rc.Left, Rc.Top+i, Rc.Right, Rc.Top+i+1));
  582.                end;
  583.           end;
  584.      end;
  585. end;
  586.  
  587. function Minimum(Value1, Value2: Cardinal): Cardinal;
  588. begin
  589.      Result:=Value1;
  590.      if Value1 > Value2 then Result:=Value2;
  591. end;
  592.  
  593. function AlignmentToChar(const Alignment: TAlignment): Char;
  594. begin
  595.      case Alignment of
  596.           taRightJustify: Result:='>';
  597.           taCenter: Result:='^';
  598.      else
  599.          Result:='<';
  600.      end;
  601. end;
  602.  
  603. {=============================================================================}
  604. { Public stuff for TPageList.                                                 }
  605. {=============================================================================}
  606.  
  607. destructor TPageList.Destroy;
  608. var
  609.    i: Integer;
  610.    Page: TPrintPage;
  611. begin
  612.      for i:=0 to Count-1 do
  613.      begin
  614.           Page:=GetPage(i);
  615.           if Page <> nil then Page.Free;
  616.      end;
  617.  
  618.      inherited Destroy;
  619. end;
  620.  
  621. function TPageList.GetPage(const Index: Integer): TPrintPage;
  622. begin
  623.      Result:=TPrintPage(Items[Index]);
  624. end;
  625.  
  626. {=============================================================================}
  627. { Public stuff for TPagePrinter.                                              }
  628. {=============================================================================}
  629.  
  630. constructor TPagePrinter.Create(Owner: TComponent);
  631. {$IFDEF PAGEPRINT_SHAREWARE}
  632. var
  633.    AboutBox: TPgPrnAboutBox;
  634. {$ENDIF}
  635. begin
  636.      fStillCreating:=True;
  637.      inherited Create(Owner);
  638. {$IFDEF PAGEPRINT_SHAREWARE}
  639.      AboutBox:=TPgPrnAboutBox.Create(Application);
  640.      try
  641.         AboutBox.ShowModal;
  642.      finally
  643.             AboutBox.Free;
  644.      end;
  645. {$ENDIF}
  646.      {We don't want a TPagePrinter to be a
  647.      container like normal TScrollBoxes can.}
  648.      ControlStyle := ControlStyle - [csAcceptsControls];
  649.      fUpdateRefCount:=0;
  650.  
  651.      fOnGetCellFormat:=nil;
  652.      fOnNewLine:=nil;
  653.      fOnNewPage:=nil;
  654.      
  655.      fHeaderFont:=TFont.Create;
  656.      fFooterFont:=TFont.Create;
  657.      fLines := TStringList.Create;
  658.      {Make this explicitly nil so UpdateProgressDlg
  659.      can tell if it needs to Create or Free itself.}
  660.      fPPPrnPrgDlg := nil;
  661.      fCancelPrinting:=False;
  662.      {Setup the scrollbars.}
  663.      HorzScrollBar.Tracking:=True;
  664.      HorzScrollBar.Increment:=16;
  665.      VertScrollBar.Tracking:=True;
  666.      VertScrollBar.Increment:=16;
  667.  
  668.      fCurrentX:=0;
  669.      fCurrentY:=0;
  670.      fLineNumber:=0;
  671.      fPageNumber:=0;
  672.      fPrintingToFile:=False;
  673.      {It's hard to zero a non-typed variable...}
  674.      FillChar(fFileVar, sizeof(fFileVar), #0);
  675.  
  676.      {Keep our own pointer to the Printer object.}
  677.      fPrinter:=Printers.Printer;
  678.  
  679.      fTokenSeparator := '|';
  680.      fZoomPercent := 25;
  681.      fZoomLocation := zlTopLeft;
  682.      fPrinting := False;
  683.      fShadowOffset:=5;
  684.      fUsingTempPage:=True;
  685.      fDefaultColWidth:=1;
  686.  
  687.      {Setup the drawing surface.}
  688.      fPaintBox := TPaintBox.Create(Self);
  689.      fPaintBox.Parent := Self;
  690.      fPaintBox.Align := alClient;
  691.      fPaintBox.OnPaint:=PaintPreview;
  692.      {Setup the page list.}
  693.      ResetPageList(False);
  694.  
  695.      {Now setup the remaining properties which depend on the canvas.}
  696.      Font.Name := 'Courier New';
  697.      Font.Size := 10;
  698.      Font.Style := [];
  699.      HeaderFont:=Font;
  700.      FooterFont:=Font;
  701.      AutoHeaderFont:=True;
  702.      AutoFooterFont:=True;
  703.  
  704.      Width := 89;
  705.      Height := 115;
  706.      Orientation:=poPortrait;
  707.      Title:='';
  708.  
  709.      LineSpacing:=lsSingleSpace;
  710.      TabSize:=8;
  711.      WordWrap:=True;
  712.      Alignment:=taLeftJustify;
  713.      PageBorders:=[];
  714.      ShowProgress:=True;
  715.      ShowCancel:=True;
  716.      Header:='';
  717.      HeaderFormat:='';
  718.      Footer:='';
  719.      FooterFormat:='';
  720.      TableFormat:='';
  721.      PageBorderOffset:=0;
  722.      DefaultColWidth:=0;
  723.      MeasureUnit:=muInches;
  724.      TableGrid:=False;
  725.      PrintToFile:=False;
  726.      ShadowColor:=clBtnShadow;
  727.      ShowMargins:=True;
  728.      GradientBackground:=True;
  729.      Collate:=True;
  730.      Copies:=1;
  731.      PrintToPage:=0;
  732.      PrintFromPage:=0;
  733.      AbortOnCancel:=False;
  734.  
  735.      MarginTop:=GutterTop;
  736.      MarginBottom:=GutterBottom;
  737.      MarginLeft:=GutterLeft;
  738.      MarginRight:=GutterRight;
  739.  
  740.      fStillCreating:=False;
  741. end;
  742.  
  743. destructor TPagePrinter.Destroy;
  744. begin
  745.      FinishPrintPage;
  746.      fPaintBox.Free;
  747.      fLines.Free;
  748.      fPages.Free;
  749.      fHeaderFont.Free;
  750.      fFooterFont.Free;
  751.      inherited Destroy;
  752. end;
  753.  
  754. procedure TPagePrinter.Clear;
  755. begin
  756.      if not Printing then
  757.      begin
  758.           ResetPageList(False);
  759.           UpdatePagePreviewSize;
  760.           Invalidate;
  761.      end
  762.      else
  763.          raise EPagePrinter.Create('Can''t clear contents while printing');
  764. end;
  765.  
  766. procedure TPagePrinter.BeginDoc;
  767. begin
  768.      {Do this before we set printing to True}
  769.      {so it refreshes the margins too.}
  770.      RefreshProperties;
  771.      {Now we set the printing flag.}
  772.      fPrinting := True;
  773.      fPrintingHeaderOrFooter := False;
  774.      if PrintToFile then
  775.      begin
  776.           SetPixelsPerInch;
  777.           AssignFile(fFileVar, FileName);
  778.           Rewrite(fFileVar);
  779.           fPrintingToFile:=True;
  780.      end
  781.      else
  782.          ResetPageList(True);
  783.      {Make extra sure we get the Font.PixelsPerInch}
  784.      {property set correctly.}
  785.      SetPixelsPerInch;
  786.      fPageNumber:=1;
  787.      DoNewPageProcessing;
  788. end;
  789.  
  790. procedure TPagePrinter.EndDoc;
  791. begin
  792.      fPrinting := False;
  793.      if PrintToFile then
  794.      begin
  795.           CloseFile(fFileVar);
  796.           FillChar(fFileVar, sizeof(fFileVar), #0);
  797.           fPrintingToFile:=False;
  798.      end
  799.      else
  800.      begin
  801.           FinishPrintPage;
  802.           CreateTempPage;
  803.           PageNumber := 1;
  804.           UpdatePagePreviewSize;
  805.           Invalidate;
  806.      end;
  807. end;
  808.  
  809. function TPagePrinter.NewPage: Cardinal;
  810. begin
  811.      if fPrintingToFile then
  812.         Writeln(fFileVar, #12)
  813.      else
  814.          NewPrintPage;
  815.      Inc(fPageNumber);
  816.      DoNewPageProcessing;
  817.      Result:=PageNumber;
  818. end;
  819.  
  820. function TPagePrinter.NewLine: Cardinal;
  821. begin
  822.      fCurrentX:=0;
  823.      fCurrentY:=fCurrentY+fLineSpace;
  824.  
  825.      {See if the entire next line will fit.}
  826.      if (not fPrintingToFile) and (not fPrintingHeaderOrFooter) and
  827.         ((fCurrentY+fLineSpace) >= PixelPrintHeight) then
  828.          NewPage
  829.      else
  830.      begin
  831.           if fPrintingToFile then Writeln(fFileVar);
  832.           Inc(fLineNumber);
  833.      end;
  834.      {Fire the event handler if it exists.}
  835.      if Assigned(fOnNewLine) then fOnNewLine(Self);
  836.      Result:=LineNumber;
  837. end;
  838.  
  839. {This function returns whether it was successful.}
  840. function TPagePrinter.PrevLine: Boolean;
  841. begin
  842.      Result:=False;
  843.      if (fCurrentY >= fLineSpace) and not fPrintingToFile then
  844.      begin
  845.           fCurrentX:=0;
  846.           fCurrentY:=fCurrentY-fLineSpace;
  847.           Dec(fLineNumber);
  848.           Result:=True;
  849.      end;
  850. end;
  851.  
  852. procedure TPagePrinter.Write(const Line: String);
  853. var
  854.    LineWidth: TPixels;
  855.    Buffer: String;
  856. begin
  857.      if Pos(#9, Line)>0 then Buffer:=ExpandTabsAsSpaces(Line, TabSize)
  858.      else Buffer:=Line;
  859.  
  860.      LineWidth:=Canvas.TextWidth(Buffer);
  861.      if (LineWidth > (PixelPrintWidth-fCurrentX)) and (Length(Buffer) > 1) then
  862.      begin
  863.           if WordWrap then SplitLineAndPrint(Buffer, True)
  864.           else Write(GetClippedLine(Buffer, PixelPrintWidth-fCurrentX));
  865.      end
  866.      else
  867.      begin
  868.           {Make sure we don't write off the end of the page.}
  869.           if (fCurrentY+fLineSpace) >= PixelPrintHeight then
  870.              if not fPrintingToFile then NewPage;
  871.           {Now print the line.}
  872.           if fPrintingToFile then
  873.              System.Write(fFileVar, Buffer)
  874.           else
  875.               Canvas.TextOut(StartingLeft+fCurrentX, StartingTop+fCurrentY, Buffer);
  876.           fCurrentX:=fCurrentX+LineWidth;
  877.      end;
  878. end;
  879.  
  880. procedure TPagePrinter.WriteLine(const Line: String);
  881. var
  882.    LineWidth: TPixels;
  883.    Buffer: String;
  884. begin
  885.      if Pos(#9, Line)>0 then Buffer:=ExpandTabsAsSpaces(Line, TabSize)
  886.      else Buffer:=Line;
  887.  
  888.      LineWidth:=Canvas.TextWidth(Buffer);
  889.      if (LineWidth > PixelPrintWidth) and (Length(Buffer) > 1) then
  890.      begin
  891.           fCurrentX:=0;
  892.           if WordWrap then SplitLineAndPrint(Buffer, False)
  893.           else WriteLine(GetClippedLine(Buffer, PixelPrintWidth));
  894.      end
  895.      else
  896.      begin
  897.           case Alignment of
  898.                taRightJustify: fCurrentX := PixelPrintWidth-LineWidth;
  899.                taCenter: fCurrentX := (PixelPrintWidth-LineWidth) shr 1;
  900.           else
  901.               fCurrentX:=0;
  902.           end;
  903.           {Make sure we don't write off the end of the page.}
  904.           if (fCurrentY+fLineSpace) >= PixelPrintHeight then
  905.              if not fPrintingToFile then NewPage;
  906.           {Now print the line.}
  907.           if fPrintingToFile then //Put spaces in for alignment purposes.
  908.              Writeln(fFileVar, GenSpace(fCurrentX div Canvas.TextWidth(' '))+Buffer)
  909.           else
  910.               Canvas.TextOut(StartingLeft+fCurrentX, StartingTop+fCurrentY, Buffer);
  911.           NewLine;
  912.      end;
  913. end;
  914.  
  915. procedure TPagePrinter.WriteLineAligned(const AAlignment: TAlignment; const Line: String);
  916. var
  917.    OldAlign: TAlignment;
  918. begin
  919.      OldAlign:=Alignment;
  920.      try
  921.         Alignment:=AAlignment;
  922.         WriteLine(Line);
  923.      finally
  924.             Alignment:=OldAlign;
  925.      end;
  926. end;
  927.  
  928. procedure TPagePrinter.WriteTableLine(const Line: String);
  929. var
  930.    FormatTokens, LineTokens: TStringList;
  931.    i, CurWidth, LeftPos, Offset: Integer;
  932.    FloatCurWidth: TMeasurement;
  933.    CurAlignment: TAlignment;
  934.    CurToken, Buffer: String;
  935.    RepeatAgain, TopGrid, WriteGrid, FirstTimeForCell: Boolean;
  936.    ColInfo: TTableLineColumnInfo;
  937.    {This local procedure sets up a lot of local variables.}
  938.    procedure WriteTableGridHelper(const i: Integer);
  939.    begin
  940.         {Get the Width and Alignment from the current column format.}
  941.         CurToken:=FormatTokens[i];
  942.         ParseFormatToken(CurToken, CurAlignment, FloatCurWidth);
  943.         WriteGrid:=TableGrid;
  944.         {Temporarily force the drawing of the Grid OFF}
  945.         if FloatCurWidth < 0 then WriteGrid:=False;
  946.         {Get the Absolute value of FloatCurWidth}
  947.         CurWidth:=MeasureUnitsToPixelsH(Abs(FloatCurWidth));
  948.    end;
  949. begin
  950.      FormatTokens:=TStringList.Create;
  951.      LineTokens:=TStringList.Create;
  952.      TopGrid:=TableGrid;
  953.      FirstTimeForCell:=True;
  954.  
  955.      try
  956.         TokenizeString(TableFormat, TokenSeparator, FormatTokens);
  957.         TokenizeString(Line, TokenSeparator, LineTokens);
  958.  
  959.         repeat
  960.               RepeatAgain:=False;
  961.               fCurrentX:=StartingLeft;
  962.               for i:=0 to FormatTokens.Count-1 do
  963.               begin
  964.                    {Set up a bunch of local variables within the local procedure.}
  965.                    WriteTableGridHelper(i);
  966.  
  967.                    {Now get a line token even if it's blank.}
  968.                    if i < LineTokens.Count then CurToken:=LineTokens[i]
  969.                    else CurToken:='';
  970.  
  971.                    (*Expand logical field names (e.g. {$LINE}).*)
  972.                    {The '{$' check is just to see if we can skip it.}
  973.                    if Pos('{$', CurToken) > 0 then
  974.                       CurToken:=ExpandLogicalFields(CurToken);
  975.  
  976.                    {Call OnGetCellFormat event.}
  977.                    if FirstTimeForCell and
  978.                       (not fPrintingHeaderOrFooter) and
  979.                       Assigned(fOnGetCellFormat) then
  980.                    begin
  981.                         {Set up the structure to be passed.}
  982.                         with ColInfo do
  983.                         begin
  984.                              Text:=CurToken;
  985.                              Width:=PixelsToMeasureUnitsH(CurWidth);
  986.                              Alignment:=CurAlignment;
  987.                              DrawGrid:=WriteGrid;
  988.                         end;
  989.                         {Fire the event.}
  990.                         fOnGetCellFormat(Self, i+1, ColInfo);
  991.                         {Reset any local variables based on the structure.}
  992.                         with ColInfo do
  993.                         begin
  994.                              CurToken:=Text;
  995.                              CurWidth:=MeasureUnitsToPixelsH(Width);
  996.                              CurAlignment:=Alignment;
  997.                              WriteGrid:=DrawGrid;
  998.                         end;
  999.                         {Reset the current format token for any wordwrapped lines.}
  1000.                         ColInfo.Width:=Abs(ColInfo.Width);
  1001.                         if not WriteGrid then ColInfo.Width:=-1*ColInfo.Width;
  1002.                         FormatTokens[i]:=AlignmentToChar(CurAlignment)+FloatToStr(ColInfo.Width);
  1003.                    end;
  1004.  
  1005.                    if WordWrap then
  1006.                    begin
  1007.                         {Determine just what will fit in the current column}
  1008.                         Buffer:=CurToken;
  1009.                         SplitLine(CurToken, Buffer, CurWidth, False);
  1010.                         {Check if a forced line break is requested}
  1011.                         LeftPos:=Pos(#10, CurToken);
  1012.                         if LeftPos > 0 then
  1013.                         begin
  1014.                              if Length(Buffer) > 0 then Buffer:=' '+Buffer;
  1015.                              Buffer:=Copy(CurToken, LeftPos+1, Length(CurToken))+Buffer;
  1016.                              Delete(CurToken, LeftPos, Length(CurToken));
  1017.                         end;
  1018.                         if i < LineTokens.Count then LineTokens[i]:=Buffer;
  1019.                         {Need to repeat loop if there is any unprinted text}
  1020.                         if Length(Buffer) > 0 then RepeatAgain:=True;
  1021.                    end
  1022.                    else
  1023.                        {Get just what will fit in the current column.}
  1024.                        CurToken:=GetClippedLine(CurToken, CurWidth);
  1025.  
  1026.                    {Figure out where the X position will be in the current column.}
  1027.                    case CurAlignment of
  1028.                         taCenter: LeftPos:=(CurWidth-Canvas.TextWidth(CurToken)) shr 1;
  1029.                         taRightJustify: LeftPos:=CurWidth-Canvas.TextWidth(CurToken);
  1030.                    else
  1031.                        LeftPos:=0;
  1032.                    end;
  1033.                    {We try to offset the text so it's not overlapping a grid border.}
  1034.                    Offset:=3*DefaultBorderWidth*(GetDeviceCaps(fPrinter.Handle, LOGPIXELSX) div DefaultDPI);
  1035.                    if Canvas.TextWidth(CurToken) < (CurWidth-Offset) then
  1036.                       if CurAlignment = taRightJustify then LeftPos:=LeftPos - Offset
  1037.                       else if CurAlignment = taLeftJustify then LeftPos:=LeftPos + Offset;
  1038.  
  1039.                    {Print out the current token.}
  1040.                    if fPrintingToFile then
  1041.                       System.Write(fFileVar, GenSpace(LeftPos div Canvas.TextWidth(' '))+CurToken+GenSpace((CurWidth-(LeftPos+Canvas.TextWidth(CurToken))) div Canvas.TextWidth(' ') ) )
  1042.                    else
  1043.                        Canvas.TextOut(fCurrentX+LeftPos, fCurrentY+StartingTop, CurToken);
  1044.  
  1045.                    {Draw the cell lines if necessary.}
  1046.                    if WriteGrid then WriteTableGrid(CurWidth, TopGrid, False);
  1047.                    {Increase fCurrentX by the COLUMN width.}
  1048.                    fCurrentX:=fCurrentX+CurWidth;
  1049.               end;
  1050.               {Do not draw the top of the grid again}
  1051.               TopGrid:=False;
  1052.               FirstTimeForCell:=False;
  1053.               if RepeatAgain then NewLine;
  1054.         until RepeatAgain = False;
  1055.  
  1056.         {Draw the Bottom of the grid if necessary}
  1057.         if TableGrid then
  1058.         begin
  1059.              fCurrentX:=StartingLeft;
  1060.              for i:=0 to FormatTokens.Count-1 do
  1061.              begin
  1062.                   {Set up a bunch of local variables within the local procedure.}
  1063.                   WriteTableGridHelper(i);
  1064.                   {Draw the cell lines if necessary.}
  1065.                   if WriteGrid then WriteTableGrid(CurWidth, False, True);
  1066.                   {Increase fCurrentX by the COLUMN width.}
  1067.                   fCurrentX:=fCurrentX+CurWidth;
  1068.              end;
  1069.         end;
  1070.      finally
  1071.             FormatTokens.Free;
  1072.             LineTokens.Free;
  1073.      end;
  1074.  
  1075.      {If we're not printing the Header or Footer, go to a new line.}
  1076.      {if ((fCurrentY >= 0) and (fCurrentY < PixelPrintHeight)) or}
  1077.      if (not fPrintingHeaderOrFooter) or fPrintingToFile then NewLine;
  1078. end;
  1079.  
  1080. procedure TPagePrinter.WriteTableGrid(const CurWidth: TPixels; const TopGrid, BottomGrid: Boolean);
  1081. var
  1082.    X, Y: Integer;
  1083. begin
  1084.      {Draw the cell lines.}
  1085.      X:=fCurrentX;
  1086.      Y:=fCurrentY+StartingTop;
  1087.      case LineSpacing of
  1088.           lsHalfSpace: Y:=Y-(fTextMetrics.tmExternalLeading shr 1);
  1089.           lsSingleSpace: Y:=Y-fTextMetrics.tmExternalLeading;
  1090.           lsSingleAndAHalf: Y:=Y-Round(fTextMetrics.tmExternalLeading*1.5);
  1091.           lsDoubleSpace: Y:=Y-(fTextMetrics.tmExternalLeading shl 1);
  1092.      end;
  1093.      {Draw the horizontal lines.}
  1094.      Canvas.Pen.Width:=DefaultBorderWidth*(GetDeviceCaps(fPrinter.Handle, LOGPIXELSY) div DefaultDPI);
  1095.      if TopGrid then
  1096.         Canvas.PolyLine([Point(X, Y), Point(X+CurWidth, Y)]);
  1097.      if BottomGrid then
  1098.         Canvas.PolyLine([Point(X, Y+fLineSpace), Point(X+CurWidth, Y+fLineSpace)]);
  1099.      {Draw the vertical lines.}
  1100.      Canvas.Pen.Width:=DefaultBorderWidth*(GetDeviceCaps(fPrinter.Handle, LOGPIXELSX) div DefaultDPI);
  1101.      Canvas.PolyLine([Point(X, Y), Point(X, Y+fLineSpace)]);
  1102.      Canvas.PolyLine([Point(X+CurWidth, Y), Point(X+CurWidth, Y+fLineSpace)]);
  1103. end;
  1104.  
  1105. procedure TPagePrinter.WriteLines(const LinesAsTable: Boolean);
  1106. var
  1107.    i: Integer; {This must allow negatives for Lines.Count-1}
  1108. begin
  1109.      for i:=0 to Lines.Count-1 do
  1110.      begin
  1111.           if LinesAsTable and (TableFormat<>'') then
  1112.              WriteTableLine(Lines[i])
  1113.           else
  1114.               WriteLine(Lines[i]);
  1115.      end;
  1116. end;
  1117.  
  1118. procedure TPagePrinter.RefreshProperties;
  1119. begin
  1120.      if not Printing then
  1121.      begin
  1122.           {Make sure the margins are correct for the current printer.}
  1123.           SetMarginTop(MarginTop);
  1124.           SetMarginBottom(MarginBottom);
  1125.           SetMarginLeft(MarginLeft);
  1126.           SetMarginRight(MarginRight);
  1127.      end;
  1128.      {Make sure the font gets sized correctly for the page.}
  1129.      GetTextMetrics(GetPrinterHandle, fTextMetrics);
  1130.      SetPixelsPerInch;
  1131.      {Make sure fLineSpace gets updated.}
  1132.      SetLineSpacing(LineSpacing);
  1133.      {Any column widths in friendly headers need to be recalculated}
  1134.      {now that we have a valid printer DC that we can get a DPI from.}
  1135.      {Also, any date and time fields need to be updated.}
  1136.      if FriendlyHeader <> '' then SetFriendlyHeader(FriendlyHeader);
  1137.      if FriendlyFooter <> '' then SetFriendlyFooter(FriendlyFooter);
  1138. end;
  1139.  
  1140. {=============================================================================}
  1141. { Private and Protected stuff for TPagePrinter.                               }
  1142. {=============================================================================}
  1143.  
  1144. procedure TPagePrinter.DoNewPageProcessing;
  1145. var
  1146.    PixelPageBorderOffset: TPixels;
  1147.    OldTableFormat: String;
  1148.    OldTableGrid, OldAutoHeaderFont, OldAutoFooterFont: Boolean;
  1149.    OldFont: TFont;
  1150.    CurX, CurY, CurLine: Integer;
  1151. begin
  1152.      {Reset the fields and fire new page event.}
  1153.      fCurrentX:=0;
  1154.      fCurrentY:=0;
  1155.      fLineNumber:=0;
  1156.      if Assigned(fOnNewPage) then fOnNewPage(Self);
  1157.  
  1158.      {Save these values in case OnNewPage modifies them.}
  1159.      CurX:=fCurrentX;
  1160.      CurY:=fCurrentY;
  1161.      CurLine:=fLineNumber;
  1162.      {Keep TableFormat because we temporarily
  1163.      change it for the Header and Footer.
  1164.      Similar for TableGrid.}
  1165.      OldTableFormat:=TableFormat;
  1166.      OldTableGrid:=TableGrid;
  1167.      TableGrid:=False;
  1168.      OldFont:=TFont.Create;
  1169.      OldFont.Assign(Font);
  1170.      OldAutoHeaderFont:=AutoHeaderFont;
  1171.      AutoHeaderFont:=False;
  1172.      OldAutoFooterFont:=AutoFooterFont;
  1173.      AutoFooterFont:=False;
  1174.      fPrintingHeaderOrFooter:=True;
  1175.      {I'm trying to center the header and footer between
  1176.       the top of the page and the PageBorders.}
  1177.      try
  1178.         {Print the header.}
  1179.         if Header <> '' then
  1180.         begin
  1181.              Font.Assign(HeaderFont);
  1182.              {fCurrentY should be negative here since we're drawing above the top margin.}
  1183.              //TLinePrinter way: fCurrentY:=((StartingTop-fLineSpace) shr 1)-StartingTop;
  1184.              if pbTop in PageBorders then
  1185.                 fCurrentY:=((MeasureUnitsToPixelsV(MarginTop-PageBorderOffset)-fLineSpace) shr 1)-MeasureUnitsToPixelsV(MarginTop)
  1186.              else
  1187.                  fCurrentY:=((MeasureUnitsToPixelsV(MarginTop)-fLineSpace) shr 1)-MeasureUnitsToPixelsV(MarginTop);
  1188.              if (fCurrentY + StartingTop) < 0 then fCurrentY := -1*StartingTop;
  1189.              TableFormat:=HeaderFormat;
  1190.              WriteTableLine(Header);
  1191.         end;
  1192.  
  1193.         {Print the footer.}
  1194.         if Footer <> '' then
  1195.         begin
  1196.              Font.Assign(FooterFont);
  1197.              //TLinePrinter Way: fCurrentY:=PixelPrintHeight+((StartingBottom-fLineSpace) shr 1);
  1198.              if pbBottom in PageBorders then
  1199.                 fCurrentY:=PixelPrintHeight+MeasureUnitsToPixelsV(PageBorderOffset)+((MeasureUnitsToPixelsV(MarginBottom-PageBorderOffset)-fLineSpace) shr 1)
  1200.              else
  1201.                  fCurrentY:=PixelPrintHeight+((MeasureUnitsToPixelsV(MarginBottom)-fLineSpace) shr 1);
  1202.              if (StartingTop+fCurrentY+fLineSpace) > MeasureUnitsToPixelsV(AvailablePageHeight) then
  1203.                 fCurrentY:=MeasureUnitsToPixelsV(AvailablePageHeight)-StartingTop-fLineSpace;
  1204.              TableFormat:=FooterFormat;
  1205.              WriteTableLine(Footer);
  1206.         end;
  1207.      finally
  1208.             fPrintingHeaderOrFooter:=False;
  1209.             {Restore the original values.}
  1210.             TableFormat:=OldTableFormat;
  1211.             TableGrid:=OldTableGrid;
  1212.             Font.Assign(OldFont);
  1213.             OldFont.Free;
  1214.             {I'm intentionally setting the private fields here.}
  1215.             fAutoHeaderFont:=OldAutoHeaderFont;
  1216.             fAutoFooterFont:=OldAutoFooterFont;
  1217.      end;
  1218.  
  1219.      {We must reset these here because printing the header and footer modifies them.}
  1220.      fCurrentX:=CurX;
  1221.      fCurrentY:=CurY;
  1222.      fLineNumber:=CurLine;
  1223.      {Fire the OnNewLine event for the first line on the page.}
  1224.      if Assigned(fOnNewLine) then fOnNewLine(Self);
  1225.  
  1226.      {Print the PageBorders.}
  1227.      with Canvas do
  1228.      begin
  1229.           Pen.Width:=DefaultBorderWidth*(GetDeviceCaps(fPrinter.Handle, LOGPIXELSY) div DefaultDPI);
  1230.           PixelPageBorderOffset:=MeasureUnitsToPixelsV(PageBorderOffset);
  1231.           if pbTop in PageBorders then
  1232.           begin
  1233.                MoveTo(StartingLeft-PixelPageBorderOffset,StartingTop-PixelPageBorderOffset);
  1234.                LineTo(StartingLeft+PixelPrintWidth+PixelPageBorderOffset, StartingTop-PixelPageBorderOffset);
  1235.           end;
  1236.           if pbBottom in PageBorders then
  1237.           begin
  1238.                MoveTo(StartingLeft-PixelPageBorderOffset, StartingTop+PixelPrintHeight+PixelPageBorderOffset);
  1239.                LineTo(StartingLeft+PixelPrintWidth+PixelPageBorderOffset, StartingTop+PixelPrintHeight+PixelPageBorderOffset);
  1240.           end;
  1241.  
  1242.           Pen.Width:=DefaultBorderWidth*(GetDeviceCaps(fPrinter.Handle, LOGPIXELSX) div DefaultDPI);
  1243.           PixelPageBorderOffset:=MeasureUnitsToPixelsH(PageBorderOffset);
  1244.           if pbLeft in PageBorders then
  1245.           begin
  1246.                MoveTo(StartingLeft-PixelPageBorderOffset, StartingTop-PixelPageBorderOffset);
  1247.                LineTo(StartingLeft-PixelPageBorderOffset, StartingTop+PixelPrintHeight+PixelPageBorderOffset);
  1248.           end;
  1249.           if pbRight in PageBorders then
  1250.           begin
  1251.                MoveTo(StartingLeft+PixelPrintWidth+PixelPageBorderOffset, StartingTop-PixelPageBorderOffset);
  1252.                LineTo(StartingLeft+PixelPrintWidth+PixelPageBorderOffset, StartingTop+PixelPrintHeight+PixelPageBorderOffset);
  1253.           end;
  1254.      end;
  1255. end;
  1256.  
  1257. procedure TPagePrinter.SplitLine(var CurLine: String; var Buffer: String; const ClipWidth: TPixels; const TrimLastWhiteSpace: Boolean);
  1258. var
  1259.    Len: Cardinal;
  1260. begin
  1261.      CurLine:=GetClippedLine(Buffer, ClipWidth);
  1262.      Len:=Length(CurLine);
  1263.      {If the next character isn't whitespace, slide back to the nearest.
  1264.      Also, like most word processors do, I'm going to delete the
  1265.      first leading whitespace character left in the next-line buffer after
  1266.      the delete/newline (if one exists).}
  1267.      if Len<Length(Buffer) then
  1268.      begin
  1269.           if not (Buffer[Len+1] in [#0..#32]) then
  1270.           begin
  1271.                CurLine:=StripBackToWhiteSpace(CurLine);
  1272.                Len:=Length(CurLine);
  1273.           end
  1274.           else
  1275.               if TrimLastWhiteSpace then Inc(Len);
  1276.      end;
  1277.      Delete(Buffer, 1, Len);
  1278. end;
  1279.  
  1280. procedure TPagePrinter.SplitLineAndPrint(const Line: String; UseWrite: Boolean);
  1281. var
  1282.    Buffer, CurLine: String;
  1283. begin
  1284.      Buffer:=Line;
  1285.      repeat
  1286.            SplitLine(CurLine, Buffer, PixelPrintWidth-fCurrentX, not UseWrite);
  1287.            if UseWrite then
  1288.            begin
  1289.                 Write(CurLine);
  1290.                 if Length(Buffer) > 0 then NewLine;
  1291.            end
  1292.            else
  1293.                WriteLine(CurLine);
  1294.      until Buffer='';
  1295. end;
  1296.  
  1297. function TPagePrinter.GetClippedLine(const Line: String; const Width: TPixels): String;
  1298. var
  1299.    PixelLen: TPixels;
  1300.    StartPos, EndPos, Mid, PreviousMid: Cardinal;
  1301. begin
  1302.      PixelLen:=Canvas.TextWidth(Line);
  1303.      if PixelLen > Width then
  1304.      begin
  1305.           EndPos:=Length(Line);
  1306.           StartPos:=1;
  1307.           Mid:=0;
  1308.           repeat
  1309.                 PreviousMid:=Mid;
  1310.                 Mid:=(StartPos+EndPos) shr 1;
  1311.                 PixelLen:=Canvas.TextWidth(Copy(Line,1,Mid));
  1312.  
  1313.                 if PixelLen > Width then EndPos:=Mid
  1314.                 else if PixelLen < Width then StartPos:=Mid
  1315.                 else StartPos:=EndPos;
  1316.           until (Mid=PreviousMid) or (StartPos>=EndPos);
  1317.           Result:=Copy(Line, 1, Mid);
  1318.      end
  1319.      else
  1320.          Result:=Line;
  1321. end;
  1322.  
  1323. function TPagePrinter.PixelPrintWidth: TPixels;
  1324. begin
  1325.      try
  1326.         Result:=MeasureUnitsToPixelsH(AvailablePageWidth)-StartingLeft-StartingRight;
  1327.      except
  1328.            on ERangeError do Result:=0;
  1329.      end;
  1330. end;
  1331.  
  1332. function TPagePrinter.PixelPrintHeight: TPixels;
  1333. begin
  1334.      try
  1335.         Result:=MeasureUnitsToPixelsV(AvailablePageHeight)-StartingTop-StartingBottom;
  1336.      except
  1337.            on ERangeError do Result:=0;
  1338.      end;
  1339. end;
  1340.  
  1341. function TPagePrinter.GetTitle: String;
  1342. begin
  1343.      try
  1344.         Result:=fPrinter.Title;
  1345.      except
  1346.            on EPrinter do Result:='<Unknown>';
  1347.      end;
  1348. end;
  1349.  
  1350. procedure TPagePrinter.SetTitle(Value: String);
  1351. begin
  1352.      try
  1353.         fPrinter.Title:=Value
  1354.      except
  1355.            on EPrinter do ;
  1356.      end;
  1357. end;
  1358.  
  1359. function TPagePrinter.GetOrientation: TPrinterOrientation;
  1360. begin
  1361.      try
  1362.         Result:=fPrinter.Orientation;
  1363.      except
  1364.            on EPrinter do Result:=poPortrait;
  1365.      end;
  1366. end;
  1367.  
  1368. procedure TPagePrinter.SetOrientation(Value: TPrinterOrientation);
  1369. begin
  1370.      if not Printing then
  1371.      begin
  1372.           try
  1373.              fPrinter.Orientation:=Value;
  1374.           except
  1375.                 on EPrinter do ;
  1376.           end;
  1377.           UpdatePagePreviewSize;
  1378.           Invalidate;
  1379.      end
  1380.      else
  1381.          raise EPagePrinter.Create('Unable to change orientation while printing');
  1382. end;
  1383.  
  1384. function TPagePrinter.GetAvailablePageHeight: TMeasurement;
  1385. begin
  1386.      try
  1387. {$IFDEF USE_SYMMETRIC_GUTTERS}
  1388.         Result:=PhysicalPageHeight-GutterTop-GutterBottom;
  1389. {$ELSE}
  1390.         Result:=PixelsToMeasureUnitsV(GetDeviceCaps(fPrinter.Handle, VERTRES));
  1391. {$ENDIF}
  1392.      except
  1393.         on EPrinter do
  1394.            if MeasureUnit = muInches then Result:=DefaultAvailablePageHeightIn
  1395.            else Result:=DefaultAvailablePageHeightMm;
  1396.      end;
  1397. end;
  1398.  
  1399. function TPagePrinter.GetAvailablePageWidth: TMeasurement;
  1400. begin
  1401.      try
  1402. {$IFDEF USE_SYMMETRIC_GUTTERS}
  1403.         Result:=PhysicalPageWidth-GutterLeft-GutterRight;
  1404. {$ELSE}
  1405.         Result:=PixelsToMeasureUnitsH(GetDeviceCaps(fPrinter.Handle, HORZRES));
  1406. {$ENDIF}
  1407.      except
  1408.         on EPrinter do
  1409.            if MeasureUnit = muInches then Result:=DefaultAvailablePageWidthIn
  1410.            else Result:=DefaultAvailablePageWidthMm;
  1411.      end;
  1412. end;
  1413.  
  1414. function TPagePrinter.GetPageNumber: Cardinal;
  1415. begin
  1416.      Result:=fPageNumber;
  1417. end;
  1418.  
  1419. function TPagePrinter.GetPrinting: Boolean;
  1420. begin
  1421.      if PrintToFile then
  1422.         Result:=fPrintingToFile
  1423.      else
  1424.          Result:=fPrinting;
  1425. end;
  1426.  
  1427. procedure TPagePrinter.SetPixelsPerInch;
  1428. var
  1429.    FontSize: Integer;
  1430. begin
  1431.      {This routine gets us around the Delphi tiny font bug.}
  1432.      FontSize := Canvas.Font.Size;
  1433.      try
  1434.         Canvas.Font.PixelsPerInch := GetDeviceCaps(fPrinter.Handle, LOGPIXELSY);
  1435.      except
  1436.            on EPrinter do Canvas.Font.PixelsPerInch:=DefaultDPI;
  1437.      end;
  1438.      if FontSize < 144 then
  1439.         Canvas.Font.Size := FontSize + 1
  1440.      else
  1441.          Canvas.Font.Size := FontSize - 1;
  1442.      Canvas.Font.Size := FontSize;
  1443. end;
  1444.  
  1445. procedure TPagePrinter.SetMarginTop(Value: TMeasurement);
  1446. begin
  1447.      if not Printing then
  1448.      begin
  1449.           if Value >= GutterTop then
  1450.           begin
  1451.                if Value <= (PhysicalPageHeight-GutterBottom) then fMarginTop:=Value
  1452.                else
  1453.                begin
  1454.                     fMarginTop:=PhysicalPageHeight-GutterBottom;
  1455.                end;
  1456.           end
  1457.           else
  1458.               fMarginTop:=GutterTop;
  1459.           Invalidate;
  1460.      end
  1461.      else raise EPagePrinter.Create('Unable to change top margin while printing');
  1462. end;
  1463.  
  1464. procedure TPagePrinter.SetMarginBottom(Value: TMeasurement);
  1465. begin
  1466.      if not Printing then
  1467.      begin
  1468.           if Value >= GutterBottom then
  1469.           begin
  1470.                if Value <= (PhysicalPageHeight-GutterTop) then fMarginBottom:=Value
  1471.                else
  1472.                begin
  1473.                     fMarginBottom:=PhysicalPageHeight-GutterTop;
  1474.                end;
  1475.           end
  1476.           else
  1477.               fMarginBottom:=GutterBottom;
  1478.           Invalidate;
  1479.      end
  1480.      else raise EPagePrinter.Create('Unable to change bottom margin while printing');
  1481. end;
  1482.  
  1483. procedure TPagePrinter.SetMarginLeft(Value: TMeasurement);
  1484. begin
  1485.      if not Printing then
  1486.      begin
  1487.           if Value >= GutterLeft then
  1488.           begin
  1489.                if Value <= (PhysicalPageWidth-GutterRight) then fMarginLeft:=Value
  1490.                else
  1491.                begin
  1492.                     fMarginLeft:=PhysicalPageWidth-GutterRight;
  1493.                end;
  1494.           end
  1495.           else
  1496.               fMarginLeft:=GutterLeft;
  1497.           Invalidate;
  1498.      end
  1499.      else raise EPagePrinter.Create('Unable to change left margin while printing');
  1500. end;
  1501.  
  1502. procedure TPagePrinter.SetMarginRight(Value: TMeasurement);
  1503. begin
  1504.      if not Printing then
  1505.      begin
  1506.           if Value >= GutterRight then
  1507.           begin
  1508.                if Value < (PhysicalPageWidth-GutterLeft) then fMarginRight:=Value
  1509.                else
  1510.                begin
  1511.                     fMarginRight:=PhysicalPageWidth-GutterLeft;
  1512.                end;
  1513.           end
  1514.           else
  1515.               fMarginRight:=GutterRight;
  1516.           Invalidate;
  1517.      end
  1518.      else raise EPagePrinter.Create('Unable to change right margin while printing');
  1519. end;
  1520.  
  1521. procedure TPagePrinter.SetMeasureUnit(Value: TMeasureUnit);
  1522. begin
  1523.      if Value <> fMeasureUnit then
  1524.      begin
  1525.           fMeasureUnit:=Value;
  1526.           if not fStillCreating then
  1527.           begin
  1528.                { Update the measurements if the units have changed.}
  1529.                if MeasureUnit = muInches then
  1530.                begin
  1531.                     MarginTop:=MarginTop/25.4;
  1532.                     MarginBottom:=MarginBottom/25.4;
  1533.                     MarginLeft:=MarginLeft/25.4;
  1534.                     MarginRight:=MarginRight/25.4;
  1535.                     PageBorderOffset:=PageBorderOffset/25.4;
  1536.                     DefaultColWidth:=DefaultColWidth/25.4;
  1537.                end
  1538.                else
  1539.                begin
  1540.                     MarginTop:=MarginTop*25.4;
  1541.                     MarginBottom:=MarginBottom*25.4;
  1542.                     MarginLeft:=MarginLeft*25.4;
  1543.                     MarginRight:=MarginRight*25.4;
  1544.                     PageBorderOffset:=PageBorderOffset*25.4;
  1545.                     DefaultColWidth:=DefaultColWidth*25.4;
  1546.                end;
  1547.                RefreshProperties;
  1548.                if FriendlyFooter = '' then fFooterFormat:=ValidateFormatString(FooterFormat, True);
  1549.                if FriendlyHeader = '' then fHeaderFormat:=ValidateFormatString(HeaderFormat, True);
  1550.                fTableFormat:=ValidateFormatString(TableFormat, True);
  1551.           end;
  1552.      end;
  1553. end;
  1554.  
  1555. procedure TPagePrinter.SetLineSpacing(Value: TLineSpacing);
  1556. var
  1557.    H: TPixels;
  1558. begin
  1559.      fLineSpacing:=Value;
  1560.      H:=Abs(Canvas.Font.Height);
  1561.      case Value of
  1562.           lsHalfSpace: fLineSpace:=H shr 1;
  1563.           lsSingleSpace: fLineSpace:=H;
  1564.           lsSingleAndAHalf: fLineSpace:=H+(H shr 1);
  1565.           lsDoubleSpace: fLineSpace:=H+H;
  1566.      end;
  1567. end;
  1568.  
  1569. function TPagePrinter.GetLines: TStrings;
  1570. begin
  1571.      {I have to do Check/Create here because C++Builder}
  1572.      {1.0 kept giving access violations if I didn't...}
  1573.      if fLines = nil then
  1574.         fLines := TStringList.Create;
  1575.      GetLines := fLines;
  1576. end;
  1577.  
  1578. procedure TPagePrinter.SetLines(Value: TStrings);
  1579. begin
  1580.      if Value = nil then
  1581.      begin
  1582.           fLines.Free;
  1583.           fLines := nil;
  1584.           Exit;
  1585.      end;
  1586.      Lines.Assign(Value);
  1587. end;
  1588.  
  1589. procedure TPagePrinter.SetDefaultColWidth(Value: TMeasurement);
  1590. begin
  1591.      fDefaultColWidth:=Value;
  1592. end;
  1593.  
  1594. procedure TPagePrinter.UpdateProgressDlg(const Status: String; const CurrentPage, FromPage, ToPage: Cardinal);
  1595. const
  1596.      DefaultProgClientHeight = 98;
  1597. begin
  1598.      if ShowProgress and (Status <> ProgressFinishMsg) then
  1599.      begin
  1600.           {Create it if is doesn't already exist.}
  1601.           if fPPPrnPrgDlg = nil then
  1602.           begin
  1603.                fPPPrnPrgDlg:=TPPPrnPrgDlg.Create(Application);
  1604.                {Set the cancel event handler.}
  1605.                fPPPrnPrgDlg.btnCancel.OnClick:=OnCancelPrinting;
  1606.                {Hide the cancel button if necessary.}
  1607.                if not ShowCancel then
  1608.                begin
  1609.                     fPPPrnPrgDlg.btnCancel.Enabled:=False;
  1610.                     fPPPrnPrgDlg.btnCancel.Visible:=False;
  1611.                     fPPPrnPrgDlg.ClientHeight:=(DefaultProgClientHeight*fPPPrnPrgDlg.PixelsPerInch) div 96;
  1612.                end;
  1613.           end;
  1614.           {Show it and bring it to the front.}
  1615.           fPPPrnPrgDlg.Show;
  1616.           {Update it as necessary.}
  1617.           with fPPPrnPrgDlg do
  1618.           begin
  1619.                Caption:=Title;
  1620.                if Status = '' then
  1621.                   lblStatus.Caption:=SendingPagesMsg
  1622.                else
  1623.                    lblStatus.Caption:=Status;
  1624.                ProgBar.Max:=Copies*(ToPage-FromPage+1);
  1625.                ProgBar.StepIt;
  1626.                lblPageNumber.Caption:='Page '+IntToStr(CurrentPage);
  1627.                if FromPage = 1 then
  1628.                begin
  1629.                     lblPageNumber.Caption:=lblPageNumber.Caption+' of '+IntToStr(ToPage-FromPage+1);
  1630.                     if Copies > 1 then
  1631.                        lblPageNumber.Caption:=lblPageNumber.Caption+' x '+IntToStr(Copies)+' Copies';
  1632.                end;
  1633.                if Showing then Update;
  1634.           end;
  1635.      end
  1636.      else
  1637.      begin
  1638.           {If it exists, get rid of it.}
  1639.           if fPPPrnPrgDlg <> nil then
  1640.           begin
  1641.                {If it is visible, close it.}
  1642.                if fPPPrnPrgDlg.Visible then fPPPrnPrgDlg.Close;
  1643.                fPPPrnPrgDlg.Free;
  1644.                fPPPrnPrgDlg := nil;
  1645.           end;
  1646.      end;
  1647. end;
  1648.  
  1649. function TPagePrinter.GetGutterTop: TMeasurement;
  1650. begin
  1651.      try
  1652.         Result:=PixelsToMeasureUnitsV(GetDeviceCaps(fPrinter.Handle, PHYSICALOFFSETY));
  1653.      except
  1654.         on EPrinter do
  1655.            if MeasureUnit = muInches then Result:=DefaultGutterTopIn
  1656.            else Result:=DefaultGutterTopMm;
  1657.      end;
  1658. end;
  1659.  
  1660. function TPagePrinter.GetGutterBottom: TMeasurement;
  1661. begin
  1662. {$IFDEF USE_SYMMETRIC_GUTTERS}
  1663.      Result:=GutterTop;
  1664. {$ELSE}
  1665.      Result:=PhysicalPageHeight-AvailablePageHeight-GutterTop;
  1666. {$ENDIF}
  1667. end;
  1668.  
  1669. function TPagePrinter.GetGutterLeft: TMeasurement;
  1670. begin
  1671.      try
  1672.         Result:=PixelsToMeasureUnitsH(GetDeviceCaps(fPrinter.Handle, PHYSICALOFFSETX));
  1673.      except
  1674.         on EPrinter do
  1675.            if MeasureUnit = muInches then Result:=DefaultGutterLeftIn
  1676.            else Result:=DefaultGutterLeftMm;
  1677.      end;
  1678. end;
  1679.  
  1680. function TPagePrinter.GetGutterRight: TMeasurement;
  1681. begin
  1682. {$IFDEF USE_SYMMETRIC_GUTTERS}
  1683.      Result:=GutterLeft;
  1684. {$ELSE}
  1685.      Result:=PhysicalPageWidth-AvailablePageWidth-GutterLeft;
  1686. {$ENDIF}
  1687. end;
  1688.  
  1689. function TPagePrinter.StartingLeft: TPixels;
  1690. begin
  1691.      Result:=MeasureUnitsToPixelsH(MarginLeft-GutterLeft);
  1692. end;
  1693.  
  1694. function TPagePrinter.StartingRight: TPixels;
  1695. begin
  1696.      Result:=MeasureUnitsToPixelsH(MarginRight-GutterRight);
  1697. end;
  1698.  
  1699. function TPagePrinter.StartingTop: TPixels;
  1700. begin
  1701.      Result:=MeasureUnitsToPixelsV(MarginTop-GutterTop);
  1702. end;
  1703.  
  1704. function TPagePrinter.StartingBottom: TPixels;
  1705. begin
  1706.      Result:=MeasureUnitsToPixelsV(MarginBottom-GutterBottom);
  1707. end;
  1708.  
  1709. function TPagePrinter.MeasureUnitsToPixelsH(const M: TMeasurement): TPixels;
  1710. var
  1711.   Temp: TMeasurement;
  1712. begin
  1713.      Temp := M;
  1714.      try
  1715.         if MeasureUnit = muMillimeters then Temp := M / 25.4;
  1716.         Result:=Round((Temp*GetDeviceCaps(fPrinter.Handle, LOGPIXELSX)));
  1717.      except
  1718.            on EPrinter do Result:=Round(Temp*DefaultDPI);
  1719.      end;
  1720. end;
  1721.  
  1722. function TPagePrinter.MeasureUnitsToPixelsV(const M: TMeasurement): TPixels;
  1723. var
  1724.   Temp: TMeasurement;
  1725. begin
  1726.      Temp := M;
  1727.      try
  1728.         if MeasureUnit = muMillimeters then Temp := M / 25.4;
  1729.         Result:=Round((Temp*GetDeviceCaps(fPrinter.Handle, LOGPIXELSY)));
  1730.      except
  1731.            on EPrinter do Result:=Round(Temp*DefaultDPI);
  1732.      end;
  1733. end;
  1734.  
  1735. function TPagePrinter.PixelsToMeasureUnitsH(const P: TPixels): TMeasurement;
  1736. begin
  1737.      try
  1738.         Result:=(P / GetDeviceCaps(fPrinter.Handle, LOGPIXELSX));
  1739.      except
  1740.            on EZeroDivide do Result:=P/DefaultDPI;
  1741.            on EPrinter do Result:=P/DefaultDPI;
  1742.      end;
  1743.      if MeasureUnit = muMillimeters then Result:=Result*25.4;
  1744. end;
  1745.  
  1746. function TPagePrinter.PixelsToMeasureUnitsV(const P: TPixels): TMeasurement;
  1747. begin
  1748.      try
  1749.         Result:=(P / GetDeviceCaps(fPrinter.Handle, LOGPIXELSY));
  1750.      except
  1751.            on EZeroDivide do Result:=P/DefaultDPI;
  1752.            on EPrinter do Result:=P/DefaultDPI;
  1753.      end;
  1754.      if MeasureUnit = muMillimeters then Result:=Result*25.4;
  1755. end;
  1756.  
  1757. procedure TPagePrinter.ParseFormatToken(var CurToken: String; var CurAlignment: TAlignment;
  1758.           var CurWidth: TMeasurement);
  1759. begin
  1760.      if CurToken = '' then CurToken:='<'+FloatToStr(DefaultColWidth);
  1761.      if Length(CurToken) = 1 then
  1762.         if (CurToken[1] in ['<', '^', '>']) then CurToken:=CurToken+FloatToStr(DefaultColWidth);
  1763.  
  1764.      {Alignment}
  1765.      case CurToken[1] of
  1766.           '<': begin
  1767.                     CurAlignment:=taLeftJustify;
  1768.                     Delete(CurToken, 1, 1);
  1769.                end;
  1770.           '^': begin
  1771.                     CurAlignment:=taCenter;
  1772.                     Delete(CurToken, 1, 1);
  1773.                end;
  1774.           '>': begin
  1775.                     CurAlignment:=taRightJustify;
  1776.                     Delete(CurToken, 1, 1);
  1777.                end;
  1778.      else
  1779.          CurAlignment:=taLeftJustify;
  1780.      end;
  1781.  
  1782.      {Width}
  1783.      try
  1784.         CurWidth:=StrToFloat(CurToken);
  1785.      except
  1786.            on EConvertError do CurWidth:=DefaultColWidth;
  1787.      end;
  1788. end;
  1789.  
  1790. function TPagePrinter.ExpandLogicalFields(S: String): String;
  1791. begin
  1792.      S:=ReplaceSubString(LineField, IntToStr(LineNumber), S);
  1793.      S:=ReplaceSubString(PageField, IntToStr(PageNumber), S);
  1794.      S:=ReplaceSubString(DateField, FormatDateTime('ddddd',Date), S);
  1795.      S:=ReplaceSubString(TimeField, FormatDateTime('tt',Time), S);
  1796.      S:=ReplaceSubString(TitleField, Title, S);
  1797.      Result:=S;
  1798. end;
  1799.  
  1800. procedure TPagePrinter.SetPageBorderOffset(Value: TMeasurement);
  1801. begin
  1802.      fPageBorderOffset:=Value;
  1803. end;
  1804.  
  1805. function TPagePrinter.GetPhysicalPageHeight: TMeasurement;
  1806. begin
  1807.      try
  1808.         Result:=PixelsToMeasureUnitsV(GetDeviceCaps(fPrinter.Handle, PHYSICALHEIGHT));
  1809.      except
  1810.         on EPrinter do
  1811.            if MeasureUnit = muInches then Result:=DefaultPhysicalPageHeightIn
  1812.            else Result:=DefaultPhysicalPageHeightMm;
  1813.      end;
  1814. end;
  1815.  
  1816. function TPagePrinter.GetPhysicalPageWidth: TMeasurement;
  1817. begin
  1818.      try
  1819.         Result:=PixelsToMeasureUnitsH(GetDeviceCaps(fPrinter.Handle, PHYSICALWIDTH));
  1820.      except
  1821.         on EPrinter do
  1822.            if MeasureUnit = muInches then Result:=DefaultPhysicalPageWidthIn
  1823.            else Result:=DefaultPhysicalPageWidthMm;
  1824.      end;
  1825. end;
  1826.  
  1827. function TPagePrinter.GetPrintableWidth: TMeasurement;
  1828. begin
  1829.      Result:=PhysicalPageWidth-MarginLeft-MarginRight;
  1830. end;
  1831.  
  1832. function TPagePrinter.GetPrintableHeight: TMeasurement;
  1833. begin
  1834.      Result:=PhysicalPageHeight-MarginTop-MarginBottom;
  1835. end;
  1836.  
  1837. procedure TPagePrinter.SetPrintToFile(Value: Boolean);
  1838. begin
  1839.      if Value <> fPrintToFile then
  1840.      begin
  1841.           if not Printing then
  1842.           begin
  1843.                fPrintToFile:=Value;
  1844.           end
  1845.           else
  1846.               raise EPagePrinter.Create('Can''t change PrintToFile while printing');
  1847.      end;
  1848. end;
  1849.  
  1850. function TPagePrinter.GetFileName: String;
  1851. begin
  1852.      Result:=fFileName;
  1853. end;
  1854.  
  1855. procedure TPagePrinter.SetFileName(Value: String);
  1856. begin
  1857.      if Value <> fFileName then
  1858.      begin
  1859.           if not Printing then
  1860.           begin
  1861.                fFileName:=Trim(Value);
  1862.           end
  1863.           else
  1864.               raise EPagePrinter.Create('Can''t change FileName while printing');
  1865.      end;
  1866. end;
  1867.  
  1868. { New stuff for TPagePrinter}
  1869.  
  1870. function TPagePrinter.MeasureUnitsToScreenPixels(const Value: TMeasurement; Horz: Boolean): TPixels;
  1871. var
  1872.    Temp: TMeasurement;
  1873.    Index: Integer;
  1874. begin
  1875.      Temp := Value;
  1876.      if MeasureUnit = muMillimeters then Temp := Value / 25.4;
  1877.      if Horz then Index:=LOGPIXELSX else Index:=LOGPIXELSY;
  1878.      if not fStillCreating then
  1879.         Result:=Round(Temp*GetDeviceCaps(fPaintBox.Canvas.Handle, Index))
  1880.      else
  1881.          Result:=Round(Temp*Screen.PixelsPerInch);
  1882. end;
  1883.  
  1884. function TPagePrinter.ScaleValue(Value: TMeasurement; Horz: Boolean): TPixels;
  1885. begin
  1886.      Result:=MeasureUnitsToScreenPixels(Value, Horz);
  1887.      Result:=Round((Result*ZoomPercent)/100);
  1888. end;
  1889.  
  1890. procedure TPagePrinter.PaintPreview(Sender: TObject);
  1891. var
  1892.    PagePixelsWidth, PagePixelsHeight: TPixels;
  1893.    XOffset, YOffset: Integer;
  1894.    R, MarginRect: TRect;
  1895. begin
  1896.      if GradientBackground then
  1897.      begin
  1898.           {At some point in the future I'd like to use the new Win32 Gradient APIs...}
  1899.           FillGradient( fPaintBox.Canvas, fPaintBox.ClientRect,
  1900.                         clBlack, Color, goVertical);
  1901.      end;
  1902.  
  1903.      with fPaintBox.Canvas do
  1904.      begin
  1905.           PagePixelsHeight:=GetPreviewPagePixelsV;
  1906.           PagePixelsWidth:=GetPreviewPagePixelsH;
  1907.           {Calculate the page area.}
  1908.           XOffset:=(fPaintBox.Width - PagePixelsWidth) div 2;
  1909.           YOffset:=(fPaintBox.Height - PagePixelsHeight) div 2;
  1910.           R.Left := XOffset;
  1911.           R.Top := YOffset;
  1912.           R.Right := PagePixelsWidth+XOffset;
  1913.           R.Bottom := PagePixelsHeight+YOffset;
  1914.           MarginRect:=R; //Save this for later.
  1915.           Pen.Style := psSolid;
  1916.           if ShadowOffset > 0 then
  1917.           begin
  1918.                {Draw the shadow.}
  1919.                Brush.Color := ShadowColor;
  1920.                Pen.Color := ShadowColor;
  1921.                {Right Portion}
  1922.                Rectangle(R.Left+PagePixelsWidth, R.Top+ShadowOffset,
  1923.                      R.Right+ShadowOffset, R.Bottom+ShadowOffset);
  1924.                {Bottom Portion}
  1925.                Rectangle(R.Left+ShadowOffset, R.Top+PagePixelsHeight,
  1926.                      R.Right, R.Bottom+ShadowOffset);
  1927.           end;
  1928.           {Draw the page.}
  1929.           Brush.Color := clWhite;
  1930.           Pen.Color := clBlack;
  1931.           Rectangle(R.Left, R.Top, R.Right, R.Bottom);
  1932.  
  1933.           {Draw the current page on the canvas.}
  1934.           if (PageNumber >= 1) and (PageNumber <= PageCount) then
  1935.           begin
  1936.                {Shrink the Rect for the picture to go in}
  1937.                Inc(R.Left, ScaleValue(GutterLeft, True)+1);
  1938.                Inc(R.Top, ScaleValue(GutterTop, False)+1);
  1939.                Inc(R.Right, 1);
  1940.                Inc(R.Bottom, 1);
  1941.                {Get the picture and draw it.}
  1942.                StretchDraw(R, Pages[PageNumber]);
  1943.           end;
  1944.  
  1945.           {Draw the margins if necessary.}
  1946.           if ShowMargins then
  1947.           begin
  1948.                Pen.Style:=psDot;
  1949.                Pen.Color:=clSilver;
  1950.                Brush.Style:=bsClear;
  1951.  
  1952.                Inc(MarginRect.Left, ScaleValue(MarginLeft, True));
  1953.                Inc(MarginRect.Top, ScaleValue(MarginTop, False));
  1954.                Dec(MarginRect.Right, ScaleValue(MarginRight, True));
  1955.                Dec(MarginRect.Bottom, ScaleValue(MarginBottom, False));
  1956.                Rectangle( MarginRect.Left, MarginRect.Top,
  1957.                           MarginRect.Right, MarginRect.Bottom );
  1958.           end;
  1959.           {Leave the pen so the TPaintBox}
  1960.           {design time border doesn't show.}
  1961.           Pen.Color:=Color;
  1962.      end;
  1963. end;
  1964.  
  1965. function TPagePrinter.GetPageCount: Cardinal;
  1966. begin
  1967.      if (fPages <> nil) then
  1968.         Result := fPages.Count
  1969.      else
  1970.          Result := 0;
  1971. end;
  1972.  
  1973. function TPagePrinter.GetZoomPercent: Cardinal;
  1974. begin
  1975.      {C++Builder 1.0 doesn't like Cardinal properties
  1976.      (or String properties) with a SetXXX procedure and
  1977.      no GetXXX function.  It will always read 0 in that
  1978.      situation.  However, Cardinal properties with no
  1979.      Get and no Set as well as properties with both
  1980.      Get and Set functions work. Thus the existence
  1981.      of this little function.} 
  1982.      Result:=fZoomPercent;
  1983. end;
  1984.  
  1985. procedure TPagePrinter.SetZoomPercent(Value: Cardinal);
  1986. begin
  1987.      fZoomPercent:=Value;
  1988.      UpdatePagePreviewSize;
  1989.      Invalidate;
  1990. end;
  1991.  
  1992. procedure TPagePrinter.ResetPageList(CreateForReal: Boolean);
  1993. begin
  1994.      FinishPrintPage;
  1995.      {Destroy the old list and all pages it contains.}
  1996.      fPages.Free;
  1997.      fPage := nil;
  1998.      {Create a new, empty list.}
  1999.      fPages:=TPageList.Create;
  2000.      fPageNumber:=0;
  2001.      {Create a new page so all the Canvas functions work.}
  2002.      if CreateForReal then
  2003.         NewPrintPage
  2004.      else
  2005.          CreateTempPage;
  2006. end;
  2007.  
  2008. procedure TPagePrinter.NewPrintPage;
  2009. begin
  2010.      CreateTempPage;
  2011.      fUsingTempPage:=False;
  2012.      fPages.Add(fPage);
  2013. end;
  2014.  
  2015. procedure TPagePrinter.FinishPrintPage;
  2016. begin
  2017.      fCanvas.Free;
  2018.      fCanvas:=nil;
  2019.      if fUsingTempPage then fPage.Free;
  2020. end;
  2021.  
  2022. procedure TPagePrinter.CreateTempPage;
  2023. begin
  2024.      FinishPrintPage;
  2025.      fUsingTempPage:=True;
  2026.      fPage:=TPrintPage.Create;
  2027.      {We MUST set the page height and width before we create the canvas.}
  2028.      fPage.Width:=MeasureUnitsToPixelsH(PhysicalPageWidth-GutterRight);
  2029.      fPage.Height:=MeasureUnitsToPixelsV(PhysicalPageHeight-GutterBottom);
  2030.  
  2031.      fCanvas:=TPrintCanvas.Create(fPage, GetPrinterHandle);
  2032.      fCanvas.Brush.Style:=bsClear;
  2033.      fCanvas.Font.Assign(Font);
  2034.      SetPixelsPerInch;
  2035. end;
  2036.  
  2037. procedure TPagePrinter.ZoomToFit;
  2038. var
  2039.    PagePixelsWidth, PagePixelsHeight: TPixels;
  2040. begin
  2041.      PagePixelsHeight:=GetPreviewPagePixelsV;
  2042.      PagePixelsWidth:=GetPreviewPagePixelsH;
  2043.      if (PagePixelsWidth/PagePixelsHeight) > (ClientWidth/ClientHeight) then
  2044.         ZoomToWidth
  2045.      else
  2046.          ZoomToHeight;
  2047. end;
  2048.  
  2049. procedure TPagePrinter.ZoomToWidth;
  2050. var
  2051.    ScrollWidth: Integer;
  2052. begin
  2053.      ScrollWidth:=GetSystemMetrics(SM_CXVSCROLL);
  2054.      ZoomPercent:=Trunc(((100*(ClientWidth-ScrollWidth-2*(ShadowOffset+1)))*GetScaleFactor(True))/MeasureUnitsToPixelsH(PhysicalPageWidth));
  2055. end;
  2056.  
  2057. procedure TPagePrinter.ZoomToHeight;
  2058. var
  2059.    ScrollHeight: Integer;
  2060. begin
  2061.      ScrollHeight:=GetSystemMetrics(SM_CYHSCROLL);
  2062.      ZoomPercent:=Trunc(((100*(ClientHeight-ScrollHeight-2*(ShadowOffset+1)))*GetScaleFactor(False))/MeasureUnitsToPixelsV(PhysicalPageHeight));
  2063. end;
  2064.  
  2065. function TPagePrinter.GetScaleFactor(Horz: Boolean): Double;
  2066. var
  2067.    Index: Integer;
  2068. begin
  2069.      Result:=1;
  2070.      if not fStillCreating then
  2071.      begin
  2072.           if Horz then Index:=LOGPIXELSX
  2073.           else Index:=LOGPIXELSY;
  2074.  
  2075.           try
  2076.              Result:=GetDeviceCaps(fPrinter.Handle, Index) / GetDeviceCaps(fPaintBox.Canvas.Handle, Index);
  2077.           except
  2078.                 on EPrinter do Result:=1;
  2079.           end;
  2080.      end;
  2081. end;
  2082.  
  2083. function TPagePrinter.GetPreviewPagePixels(Horz: Boolean): TPixels;
  2084. var
  2085.    Index: Integer;
  2086.    Measure: TMeasurement;
  2087. begin
  2088.      if Horz then Index:=PHYSICALWIDTH
  2089.      else Index:=PHYSICALHEIGHT;
  2090.  
  2091.      try
  2092.         Result:=GetDeviceCaps(fPrinter.Handle, Index);
  2093.      except
  2094.            on EPrinter do
  2095.            begin
  2096.                 if MeasureUnit = muInches then
  2097.                 begin
  2098.                      if Horz then Measure:=DefaultPhysicalPageWidthIn
  2099.                      else Measure:=DefaultPhysicalPageHeightIn;
  2100.                 end
  2101.                 else
  2102.                 begin
  2103.                      if Horz then Measure:=DefaultPhysicalPageWidthMm
  2104.                      else Measure:=DefaultPhysicalPageHeightMm;
  2105.                 end;
  2106.                 Result:=MeasureUnitsToScreenPixels(Measure, Horz);
  2107.            end;
  2108.      end;
  2109.      Result:=Round((Result*ZoomPercent/GetScaleFactor(Horz))/100);
  2110. end;
  2111.  
  2112. function TPagePrinter.GetPreviewPagePixelsH: TPixels;
  2113. begin
  2114.      Result:=GetPreviewPagePixels(True);
  2115. end;
  2116.  
  2117. function TPagePrinter.GetPreviewPagePixelsV: TPixels;
  2118. begin
  2119.      Result:=GetPreviewPagePixels(False);
  2120. end;
  2121.  
  2122. procedure TPagePrinter.SetPageNumber(Value: Cardinal);
  2123. begin
  2124.      if (Value >= 1) and (Value <= PageCount) then
  2125.      begin
  2126.           fPageNumber:=Value;
  2127.           UpdatePagePreviewSize;
  2128.           Invalidate;
  2129.      end
  2130.      else
  2131.      begin
  2132.           if (csLoading in ComponentState) or (PageCount = 0) then
  2133.              fPageNumber:=0
  2134.           else
  2135.               raise EPagePrinter.Create('PageNumber must be between 1 and '+IntToStr(PageCount));
  2136.      end;
  2137. end;
  2138.  
  2139. procedure TPagePrinter.SetShadowOffset(Value: TPixels);
  2140. begin
  2141.      if Value <> fShadowOffset then
  2142.      begin
  2143.           fShadowOffset:=Value;
  2144.           UpdatePagePreviewSize;
  2145.           Invalidate;
  2146.      end;
  2147. end;
  2148.  
  2149. procedure TPagePrinter.UpdatePagePreviewSize;
  2150. begin
  2151.      {Setup the scrolling region.}
  2152.      HorzScrollBar.Range := GetPreviewPagePixelsH+2*(ShadowOffset+1);
  2153.      VertScrollBar.Range := GetPreviewPagePixelsV+2*(ShadowOffset+1);
  2154.      if not fStillCreating then
  2155.      begin
  2156.           case ZoomLocation of
  2157.                zlTopLeft:
  2158.                begin
  2159.                     {Sometimes nothing happens if I go straight to 0;}
  2160.                     HorzScrollBar.Position := 1;
  2161.                     HorzScrollBar.Position := 0;
  2162.                     VertScrollBar.Position := 1;
  2163.                     VertScrollBar.Position := 0;
  2164.                end;
  2165.                zlTopCenter: //Center the page horizontally and go to top vertically.
  2166.                begin
  2167.                     HorzScrollBar.Position := (HorzScrollBar.Range - ClientWidth) div 2;
  2168.                     VertScrollBar.Position := 1;
  2169.                     VertScrollBar.Position := 0;
  2170.                end;
  2171.                zlCenter:
  2172.                begin
  2173.                     HorzScrollBar.Position := (HorzScrollBar.Range - ClientWidth) div 2;
  2174.                     VertScrollBar.Position := (VertScrollBar.Range - ClientHeight) div 2;
  2175.                end;
  2176.           end;
  2177.      end;
  2178. end;
  2179.  
  2180. procedure TPagePrinter.Loaded;
  2181. begin
  2182.      inherited Loaded;
  2183.      RefreshProperties;
  2184.      ResetPageList(False);
  2185.      UpdatePagePreviewSize;
  2186.      {Make it so the TPaintBox design time border is invisible.}
  2187.      fPaintBox.Canvas.Pen.Color:=Color;
  2188.      Invalidate;
  2189. end;
  2190.  
  2191. procedure TPagePrinter.CMFontChanged(var Msg: TMessage);
  2192. begin
  2193.      inherited;
  2194.      Canvas.Font.Assign(Font);
  2195.      SetPixelsPerInch;
  2196.      GetTextMetrics(GetPrinterHandle, fTextMetrics);
  2197.      {Force fLineSpace to be updated.}
  2198.      SetLineSpacing(LineSpacing);
  2199.      if AutoHeaderFont then HeaderFont:=Font;
  2200.      if AutoFooterFont then FooterFont:=Font;
  2201. end;
  2202.  
  2203. procedure TPagePrinter.SetShadowColor(Value: TColor);
  2204. begin
  2205.      if Value <> fShadowColor then
  2206.      begin
  2207.           fShadowColor:=Value;
  2208.           Invalidate;
  2209.      end;
  2210. end;
  2211.  
  2212. procedure TPagePrinter.SetShowMargins(Value: Boolean);
  2213. begin
  2214.      if Value <> fShowMargins then
  2215.      begin
  2216.           fShowMargins:=Value;
  2217.           Invalidate;
  2218.      end;
  2219. end;
  2220.  
  2221. procedure TPagePrinter.SetGradientBackground(Value: Boolean);
  2222. begin
  2223.      if Value <> fGradientBackground then
  2224.      begin
  2225.           fGradientBackground:=Value;
  2226.           Invalidate;
  2227.      end;
  2228. end;
  2229.  
  2230. procedure TPagePrinter.UpdateDesigner;
  2231. begin
  2232.      if csDesigning in ComponentState then
  2233.         if (GetParentForm(Self) <> nil) then
  2234.            if (GetParentForm(Self).Designer <> nil) then
  2235.               GetParentForm(Self).Designer.Modified;
  2236. end;
  2237.  
  2238. procedure TPagePrinter.ExpandFriendlyFormat(const UserFmt: String; AsHeader: Boolean);
  2239. var
  2240.    LayoutTokens: TStringList;
  2241.    NextCharIsSpecifier, TextAddOn: Boolean;
  2242.    i: Integer;
  2243.    FmtText, FmtLayout, Value: String;
  2244. begin
  2245.     LayoutTokens:=TStringList.Create;
  2246.     try
  2247.        NextCharIsSpecifier := False;
  2248.        FmtText:='';
  2249.        for i:=1 to Length(UserFmt) do
  2250.        begin
  2251.             {If it's an &, the next char is important.}
  2252.             if (UserFmt[i] = '&') then
  2253.                NextCharIsSpecifier := True
  2254.             {The current char is a specifier of some sort.}
  2255.             else if NextCharIsSpecifier then
  2256.             begin
  2257.                  Value := '';
  2258.                  TextAddOn := True;
  2259.                  case UserFmt[i] of
  2260.                      'f': Value := ExtractFileName(FileName);
  2261.                      'F': Value := FileName;
  2262.                      'd': Value := FormatDateTime('ddddd', Date);
  2263.                      't': Value := FormatDateTime('t', Time);
  2264.                      'D': Value := FormatDateTime('dddddd', Date);
  2265.                      'T': Value := FormatDateTime('tt', Time);
  2266.                      'p': Value := PageField;
  2267.                      'i': Value := TitleField;
  2268.                      '&': Value := '&';
  2269.                      'l': begin Value := '<'; TextAddOn := False; end;
  2270.                      'c': begin Value := '^'; TextAddOn := False; end;
  2271.                      'r': begin Value := '>'; TextAddOn := False; end;
  2272.                  end;
  2273.                  {An empty filename will throw things off so we put in a space.}
  2274.                  if Value = '' then Value:=' ';
  2275.  
  2276.                  if TextAddOn then
  2277.                     FmtText:=FmtText+Value
  2278.                  else //We encountered an alignment specifier.
  2279.                  begin
  2280.                       if FmtText <> '' then
  2281.                       begin
  2282.                            if LayoutTokens.Count = 0 then LayoutTokens.Add('<');
  2283.                            FmtText:=FmtText+TokenSeparator;
  2284.                       end;
  2285.                       LayoutTokens.Add(Value);
  2286.                  end;
  2287.                  NextCharIsSpecifier := False;
  2288.             end
  2289.             {Otherwise we just add it on the Text string.}
  2290.             else
  2291.                 FmtText:=FmtText+UserFmt[i];
  2292.        end;
  2293.  
  2294.        {Now build the Layout string;}
  2295.        FmtLayout:='';
  2296.        if LayoutTokens.Count = 0 then LayoutTokens.Add('<');
  2297.        Value := Trim(FloatToStr(PrintableWidth / LayoutTokens.Count));
  2298.        for i:=0 to LayoutTokens.Count-1 do
  2299.        begin
  2300.             if FmtLayout <> '' then FmtLayout:=FmtLayout+TokenSeparator;
  2301.             FmtLayout:=FmtLayout+LayoutTokens[i]+Value;
  2302.        end;
  2303.     finally
  2304.            LayoutTokens.Free;
  2305.     end;
  2306.  
  2307.     {Now set the header or footer properties.}
  2308.     if AsHeader then
  2309.     begin
  2310.          Header:=FmtText;
  2311.          HeaderFormat:=FmtLayout;
  2312.     end
  2313.     else
  2314.     begin
  2315.          Footer:=FmtText;
  2316.          FooterFormat:=FmtLayout;
  2317.     end;
  2318. end;
  2319.  
  2320. function TPagePrinter.GetFriendlyFooter: String;
  2321. begin
  2322.      Result:=fFriendlyFooter;
  2323. end;
  2324.  
  2325. procedure TPagePrinter.SetFriendlyFooter(Value: String);
  2326. begin
  2327.      fFriendlyFooter:=Value;
  2328.      if not (csLoading in ComponentState) then
  2329.         ExpandFriendlyFormat(Value, False);
  2330. end;
  2331.  
  2332. function TPagePrinter.GetFriendlyHeader: String;
  2333. begin
  2334.      Result:=fFriendlyHeader;
  2335. end;
  2336.  
  2337. procedure TPagePrinter.SetFriendlyHeader(Value: String);
  2338. begin
  2339.      fFriendlyHeader:=Value;
  2340.      if not (csLoading in ComponentState) then
  2341.         ExpandFriendlyFormat(Value, True);
  2342. end;
  2343.  
  2344. function TPagePrinter.GetPrinterHandle: HDC;
  2345. begin
  2346.      try
  2347.         Result:=fPrinter.Handle;
  2348.      except
  2349.            on EPrinter do Result:=0;
  2350.      end;
  2351. end;
  2352.  
  2353. procedure TPagePrinter.SetCopies(Value: Cardinal);
  2354. begin
  2355.      if Value > 0 then
  2356.         fCopies:=Value
  2357.      else
  2358.          fCopies:=1;
  2359. end;
  2360.  
  2361. function TPagePrinter.GetCopies: Cardinal;
  2362. begin
  2363.      GetCopies:=fCopies;
  2364. end;
  2365.  
  2366. procedure TPagePrinter.SetCollate(Value: Boolean);
  2367. begin
  2368.      fCollate:=Value
  2369. end;
  2370.  
  2371. function TPagePrinter.GetPrintToPage: Cardinal;
  2372. begin
  2373.      Result:=fPrintToPage;
  2374. end;
  2375.  
  2376. procedure TPagePrinter.SetPrintToPage(Value: Cardinal);
  2377. begin
  2378.      if Value <> fPrintToPage then
  2379.      begin
  2380.           fPrintToPage:=Value;
  2381.           if fPrintToPage < fPrintFromPage then
  2382.              PrintFromPage:=fPrintToPage;
  2383.      end;
  2384. end;
  2385.  
  2386. function TPagePrinter.GetPrintFromPage: Cardinal;
  2387. begin
  2388.      Result:=fPrintFromPage;
  2389. end;
  2390.  
  2391. procedure TPagePrinter.SetPrintFromPage(Value: Cardinal);
  2392. begin
  2393.      if Value <> fPrintFromPage then
  2394.      begin
  2395.           fPrintFromPage:=Value;
  2396.           if fPrintFromPage > fPrintToPage then
  2397.              PrintToPage:=fPrintFromPage;
  2398.      end;
  2399. end;
  2400.  
  2401. type //This type is only used in this function.
  2402.   ECancelPrinting = class(EPagePrinter);
  2403.  
  2404. function TPagePrinter.Print: Boolean;
  2405.     procedure DoPrintPage(Pg, FromPage, ToPage: Integer; LastPage: Boolean);
  2406.     begin
  2407.          {Cancel printing if necessary.}
  2408.          if ShowProgress and ShowCancel then
  2409.             Application.ProcessMessages;
  2410.          if fCancelPrinting then
  2411.             raise ECancelPrinting.Create('Printing Cancelled');
  2412.             
  2413.          {Now print the page.}
  2414.          UpdateProgressDlg(ProgressMessage, Pg, FromPage, ToPage);
  2415.          fPrinter.Canvas.Draw(0, 0, Pages[Pg]);
  2416.          if not LastPage then fPrinter.NewPage;
  2417.     end;    
  2418. var
  2419.    Cp, Pg, PrevPrnCopies: Integer;
  2420.    ToPage, FromPage: Cardinal;
  2421. begin
  2422.      {Return True unless printing was cancelled.}
  2423.      Result:=True;
  2424.      {Call EndDoc if necessary.}
  2425.      if Printing then EndDoc;
  2426.  
  2427.      if PageCount > 0 then
  2428.      begin
  2429.           {Determine the page range to print.}
  2430.           if PrintFromPage = 0 then
  2431.              FromPage:=1
  2432.           else
  2433.               FromPage:=Minimum(PrintFromPage, PageCount);
  2434.           if PrintToPage = 0 then
  2435.              ToPage:=PageCount
  2436.           else
  2437.               ToPage:=Minimum(PrintToPage, PageCount);
  2438.  
  2439.           {We're handling the copies not the printer.}
  2440.           PrevPrnCopies:=fPrinter.Copies;
  2441.           fPrinter.Copies:=1;
  2442.           
  2443.           {Set up the print cancelling code.}
  2444.           fCancelPrinting:=False;
  2445.           try
  2446.              {Print the pages on the printer using Collate and Copies.}
  2447.              try
  2448.                 fPrinter.BeginDoc;
  2449.                 if Collate then //Print 1,2,3; 1,2,3
  2450.                 begin
  2451.                      for Cp:=1 to Copies do
  2452.                          for Pg:=FromPage to ToPage do
  2453.                              DoPrintPage(Pg, FromPage, ToPage, ((Pg=ToPage) and (Cp=Copies)));
  2454.                 end
  2455.                 else //Print 1,1; 2,2; 3,3
  2456.                 begin
  2457.                      for Pg:=FromPage to ToPage do
  2458.                          for Cp:=1 to Copies do
  2459.                              DoPrintPage(Pg, FromPage, ToPage, ((Pg=ToPage) and (Cp=Copies)));
  2460.                 end;
  2461.                 fPrinter.EndDoc;
  2462.              finally
  2463.                     UpdateProgressDlg(ProgressFinishMsg, 0, 0, 0);
  2464.                     if not fPrinter.Printing then
  2465.                        fPrinter.Copies:=PrevPrnCopies;
  2466.              end;
  2467.           except
  2468.                 on ECancelPrinting do
  2469.                 begin
  2470.                      Result:=False; //Return False since is was cancelled.
  2471.                      if fPrinter.Printing then
  2472.                      begin
  2473.                           {I'd like to always Abort printing,
  2474.                           but I've found that calling Abort
  2475.                           multiple times will crash programs.
  2476.                           Thus you can optionally use EndDoc.}
  2477.                           if AbortOnCancel then fPrinter.Abort
  2478.                           else fPrinter.EndDoc;
  2479.                      end;
  2480.                 end;
  2481.           end;
  2482.      end;
  2483. end;
  2484.  
  2485. function TPagePrinter.GetHeaderFont: TFont;
  2486. begin
  2487.      Result:=fHeaderFont;
  2488. end;
  2489.  
  2490. procedure TPagePrinter.SetHeaderFont(Value: TFont);
  2491. begin
  2492.      fHeaderFont.Assign(Value);
  2493. end;
  2494.  
  2495. function TPagePrinter.GetFooterFont: TFont;
  2496. begin
  2497.      Result:=fFooterFont;
  2498. end;
  2499.  
  2500. procedure TPagePrinter.SetFooterFont(Value: TFont);
  2501. begin
  2502.      fFooterFont.Assign(Value);
  2503. end;
  2504.  
  2505. procedure TPagePrinter.SetAutoHeaderFont(Value: Boolean);
  2506. begin
  2507.      if fAutoHeaderFont <> Value then
  2508.      begin
  2509.           fAutoHeaderFont:=Value;
  2510.           if not (csLoading in ComponentState) then
  2511.              if fAutoHeaderFont then
  2512.                 HeaderFont:=Font;
  2513.      end;
  2514. end;
  2515.  
  2516. procedure TPagePrinter.SetAutoFooterFont(Value: Boolean);
  2517. begin
  2518.      if fAutoFooterFont <> Value then
  2519.      begin
  2520.           fAutoFooterFont:=Value;
  2521.           if not (csLoading in ComponentState) then
  2522.              if fAutoFooterFont then
  2523.                 FooterFont:=Font;
  2524.      end;
  2525. end;
  2526.  
  2527. procedure TPagePrinter.Invalidate;
  2528. begin
  2529.      if fUpdateRefCount = 0 then
  2530.         inherited Invalidate;
  2531. end;
  2532.  
  2533. procedure TPagePrinter.BeginUpdate;
  2534. begin
  2535.      Inc(fUpdateRefCount);
  2536. end;
  2537.  
  2538. procedure TPagePrinter.EndUpdate;
  2539. begin
  2540.      if fUpdateRefCount > 0 then Dec(fUpdateRefCount);
  2541.      if fUpdateRefCount = 0 then Invalidate;
  2542. end;
  2543.  
  2544. function TPagePrinter.GetCanvasPosition: TPoint;
  2545. begin
  2546.      Result:=Point(fCurrentX+StartingLeft, fCurrentY+StartingTop);
  2547. end;
  2548.  
  2549. function TPagePrinter.GetPages(Indx: Cardinal): TPrintPage;
  2550. begin
  2551.      Result:=fPages.GetPage(Indx-1);
  2552. end;
  2553.  
  2554. function TPagePrinter.GetProgressMessage: String;
  2555. begin
  2556.      Result:=fProgressMessage;
  2557. end;
  2558.  
  2559. procedure TPagePrinter.SetProgressMessage(Value: String);
  2560. begin
  2561.      fProgressMessage:=Value;
  2562. end;
  2563.  
  2564. function TPagePrinter.GetCanvas: TPrintCanvas;
  2565. begin
  2566.      Result:=fCanvas;
  2567. end;
  2568.  
  2569. function TPagePrinter.GetLineNumber: Cardinal;
  2570. begin
  2571.      Result:=fLineNumber;
  2572. end;
  2573.  
  2574. function TPagePrinter.GetAutoFooterFont: Boolean;
  2575. begin
  2576.      Result:=fAutoFooterFont;
  2577. end;
  2578.  
  2579. function TPagePrinter.GetAutoHeaderFont: Boolean;
  2580. begin
  2581.      Result:=fAutoHeaderFont;
  2582. end;
  2583.  
  2584. function TPagePrinter.GetCollate: Boolean;
  2585. begin
  2586.      Result:=fCollate;
  2587. end;
  2588.  
  2589. function TPagePrinter.GetDefaultColWidth: TMeasurement;
  2590. begin
  2591.      Result:=fDefaultColWidth;
  2592. end;
  2593.  
  2594. function TPagePrinter.GetGradientBackground: Boolean;
  2595. begin
  2596.      Result:=fGradientBackground;
  2597. end;
  2598.  
  2599. function TPagePrinter.GetLineSpacing: TLineSpacing;
  2600. begin
  2601.      Result:=fLineSpacing;
  2602. end;
  2603.  
  2604. function TPagePrinter.GetMarginBottom: TMeasurement;
  2605. begin
  2606.      Result:=fMarginBottom;
  2607. end;
  2608.  
  2609. function TPagePrinter.GetMarginLeft: TMeasurement;
  2610. begin
  2611.      Result:=fMarginLeft;
  2612. end;
  2613.  
  2614. function TPagePrinter.GetMarginRight: TMeasurement;
  2615. begin
  2616.      Result:=fMarginRight;
  2617. end;
  2618.  
  2619. function TPagePrinter.GetMarginTop: TMeasurement;
  2620. begin
  2621.      Result:=fMarginTop;
  2622. end;
  2623.  
  2624. function TPagePrinter.GetMeasureUnit: TMeasureUnit;
  2625. begin
  2626.      Result:=fMeasureUnit;
  2627. end;
  2628.  
  2629. function TPagePrinter.GetPageBorderOffset: TMeasurement;
  2630. begin
  2631.      Result:=fPageBorderOffset;
  2632. end;
  2633.  
  2634. function TPagePrinter.GetPrintToFile: Boolean;
  2635. begin
  2636.      Result:=fPrintToFile;
  2637. end;
  2638.  
  2639. function TPagePrinter.GetShadowColor: TColor;
  2640. begin
  2641.      Result:=fShadowColor;
  2642. end;
  2643.  
  2644. function TPagePrinter.GetShadowOffset: TPixels;
  2645. begin
  2646.      Result:=fShadowOffset;
  2647. end;
  2648.  
  2649. function TPagePrinter.GetShowMargins: Boolean;
  2650. begin
  2651.      Result:=fShowMargins;
  2652. end;
  2653.  
  2654. function TPagePrinter.GetShowProgress: Boolean;
  2655. begin
  2656.      Result:=fShowProgress;
  2657. end;
  2658.  
  2659. function TPagePrinter.GetPageBorders: TPageBorders;
  2660. begin
  2661.      Result:=fPageBorders;
  2662. end;
  2663.  
  2664. procedure TPagePrinter.SetPageBorders(Value: TPageBorders);
  2665. begin
  2666.      fPageBorders:=Value;
  2667. end;
  2668.  
  2669. procedure TPagePrinter.OnCancelPrinting(Sender: TObject);
  2670. begin
  2671.      fCancelPrinting:=True;
  2672. end;
  2673.  
  2674. procedure TPagePrinter.SetShowProgress(Value: Boolean);
  2675. begin
  2676.      fShowProgress:=Value;
  2677. end;
  2678.  
  2679. function TPagePrinter.GetShowCancel: Boolean;
  2680. begin
  2681.      Result:=fShowCancel;
  2682. end;
  2683.  
  2684. procedure TPagePrinter.SetShowCancel(Value: Boolean);
  2685. begin
  2686.      fShowCancel:=Value;
  2687. end;
  2688.  
  2689. function TPagePrinter.StoreFooterAndFormat: Boolean;
  2690. begin
  2691.      Result:=FriendlyFooter = '';
  2692. end;
  2693.  
  2694. function TPagePrinter.StoreFooterFont: Boolean;
  2695. begin
  2696.      Result:=not AutoFooterFont;
  2697. end;
  2698.  
  2699. function TPagePrinter.StoreHeaderAndFormat: Boolean;
  2700. begin
  2701.      Result:=FriendlyHeader = '';
  2702. end;
  2703.  
  2704. function TPagePrinter.StoreHeaderFont: Boolean;
  2705. begin
  2706.      Result:=not AutoHeaderFont;
  2707. end;
  2708.  
  2709. function TPagePrinter.ValidateFormatString(const Fmt: String; const ConvertUnits: Boolean): String;
  2710. var
  2711.    FormatTokens: TStringList;
  2712.    i: Integer;
  2713.    CurAlignment: TAlignment;
  2714.    CurWidth: TMeasurement;
  2715.    AlignmentChar: Char;
  2716.    Buffer: String;
  2717. begin
  2718.      Result:='';
  2719.      if Fmt <> '' then
  2720.      begin
  2721.           FormatTokens:=TStringList.Create;
  2722.           try
  2723.              TokenizeString(Fmt, TokenSeparator, FormatTokens);
  2724.              for i:=0 to FormatTokens.Count-1 do
  2725.              begin
  2726.                   Buffer:=FormatTokens[i];
  2727.                   ParseFormatToken(Buffer, CurAlignment, CurWidth);
  2728.                   if Result <> '' then Result:=Result+TokenSeparator;
  2729.                   AlignmentChar:=AlignmentToChar(CurAlignment);
  2730.                   if ConvertUnits then
  2731.                   begin
  2732.                        if MeasureUnit = muInches then CurWidth:=CurWidth/25.4
  2733.                        else CurWidth:=CurWidth*25.4;
  2734.                   end;
  2735.                   Result:=Result+AlignmentChar+Trim(FloatToStr(CurWidth));
  2736.              end;
  2737.           finally
  2738.                  FormatTokens.Free;
  2739.           end;
  2740.      end;
  2741. end;
  2742.  
  2743. function TPagePrinter.GetFooterFormat: String;
  2744. begin
  2745.      Result:=fFooterFormat;
  2746. end;
  2747.  
  2748. procedure TPagePrinter.SetFooterFormat(Value: String);
  2749. begin
  2750.      fFooterFormat:=ValidateFormatString(Value, false);
  2751. end;
  2752.  
  2753. function TPagePrinter.GetHeaderFormat: String;
  2754. begin
  2755.      Result:=fHeaderFormat;
  2756. end;
  2757.  
  2758. procedure TPagePrinter.SetHeaderFormat(Value: String);
  2759. begin
  2760.      fHeaderFormat:=ValidateFormatString(Value, false);
  2761. end;
  2762.  
  2763. function TPagePrinter.GetTableFormat: String;
  2764. begin
  2765.      Result:=fTableFormat;
  2766. end;
  2767.  
  2768. procedure TPagePrinter.SetTableFormat(Value: String);
  2769. begin
  2770.      fTableFormat:=ValidateFormatString(Value, false);
  2771. end;
  2772.  
  2773. end.
  2774.  
  2775.